home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / egg / egg.el.z / egg.el
Encoding:
Text File  |  1998-05-21  |  94.2 KB  |  2,948 lines
  1. ;; Japanese Character Input Package for Egg
  2. ;; Coded by S.Tomura, Electrotechnical Lab. (tomura@etl.go.jp)
  3.  
  4. ;; This file is part of Egg on Mule (Multilingal Environment)
  5.  
  6. ;; Egg is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 2, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; Egg is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;; GNU General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. ;;;==================================================================
  21. ;;;
  22. ;;; $BF|K\8l4D6-(B $B!V$?$^$4!W(B $BBh#3HG(B    
  23. ;;;
  24. ;;;=================================================================== 
  25.  
  26. ;;;
  27. ;;;$B!V$?$^$4!W$O%M%C%H%o!<%/$+$J4A;zJQ49%5!<%P$rMxMQ$7!"(BMule $B$G$NF|K\(B
  28. ;;; $B8l4D6-$rDs6!$9$k%7%9%F%`$G$9!#!V$?$^$4!WBh#2HG$G$O(B Wnn V3 $B$*$h$S(B 
  29. ;;; Wnn V4 $B$N$+$J4A;zJQ49%5!<%P$r;HMQ$7$F$$$^$9!#(B
  30. ;;;
  31.  
  32. ;;; $BL>A0$O(B $B!VBt;3(B/$BBT$?$;$F(B/$B$4$a$s$J$5$$!W$N3FJ8@a$N@hF,#12;$G$"$k!V$?!W(B
  33. ;;; $B$H!V$^!W$H!V$4!W$r<h$C$F!"!V$?$^$4!W$H8@$$$^$9!#EE;R5;=QAm9g8&5f=j(B
  34. ;;; $B$N6S8+(B $BH~5.;R;a$NL?L>$K0M$k$b$N$G$9!#(Begg $B$O!V$?$^$4!W$N1QLu$G$9!#(B
  35.  
  36. ;;;
  37. ;;; $B;HMQK!$O(B info/egg-jp $B$r8+$F2<$5$$!#(B
  38. ;;;
  39.  
  40. ;;;
  41. ;;; $B!V$?$^$4!W$K4X$9$kDs0F!"Cn>pJs$O(B tomura@etl.go.jp $B$K$*Aw$j2<$5$$!#(B
  42. ;;;
  43.  
  44. ;;;
  45. ;;;                      $B")(B 305 $B0q>k8)$D$/$P;TG_1`(B1-1-4
  46. ;;;                      $BDL;:>J9)6H5;=Q1!EE;R5;=QAm9g8&5f=j(B
  47. ;;;                      $B>pJs%"!<%-%F%/%A%cIt8@8l%7%9%F%`8&5f<<(B
  48. ;;;
  49. ;;;                                                     $B8MB<(B $BE/(B  
  50.  
  51. ;;;
  52. ;;; ($BCm0U(B)$B$3$N%U%!%$%k$O4A;z%3!<%I$r4^$s$G$$$^$9!#(B 
  53. ;;;
  54. ;;;   $BBh#3HG(B  $B#1#9#9#1G/#27n(B  $B#4F|(B
  55. ;;;   $BBh#2HG(B  $B#1#9#8#9G/#67n(B  $B#1F|(B
  56. ;;;   $BBh#1HG(B  $B#1#9#8#8G/#77n#1#4F|(B
  57. ;;;   $B;CDjHG(B  $B#1#9#8#8G/#67n#2#4F|(B
  58.  
  59. ;;;=================================================================== 
  60. ;;;
  61. ;;; (eval-when (load) (require 'wnn-client))
  62. ;;;
  63.  
  64. ; last master version
  65. ;;; (defvar egg-version "3.09" "Version number of this version of Egg. ")
  66. ;;; Last modified date: Fri Sep 25 12:59:00 1992
  67. (defvar egg-version "3.10 xemacs" "Version number of this version of Egg. ")
  68. ;;; Last modified date: Wed Nov 29 20:45:00 1997
  69.  
  70. ;;;;  $B=$@5MW5a%j%9%H(B
  71.  
  72. ;;;;  read-hiragana-string, read-kanji-string $B$G;HMQ$9$kJ?2>L>F~NO%^%C%W$r(B roma-kana $B$K8GDj$7$J$$$GM_$7$$!%(B
  73.  
  74. ;;;;  $B=$@5%a%b(B
  75.  
  76. ;;; 97.10.29 modified by J.Hein <jareth@camelot-soft.com>
  77. ;;; fix to get rid of problem with C-h/backspace fuckage when in fence mode. Note
  78. ;;; that the entire egg-read-event thing is a hack and really needs to be re-implemented.
  79. ;;; I REALLY don't like the bandaids there...
  80. ;;; Also added the egg-mode function, and modified the behavior so that just loading
  81. ;;; egg will not change the user's state.
  82.  
  83. ;;; 97.2.05 modified by J.Hein <jhod@po.iijnet.or.jp>
  84. ;;; Lots of mods to make it XEmacs workable. Most fixes revolve around the fact that
  85. ;;; Mule/et al assumes that all events are keypress events unless specified otherwise.
  86. ;;; Also modified to work with the new charset names and API
  87.  
  88. ;;; 95.6.5 modified by S.Tomura <tomura@etl.go.jp>
  89. ;;; $BJQ49D>8e$KO"B3$7$FJQ49$9$k>l9g$rG'<1$9$k$?$a$K!"(B"-in-cont" $B$K4XO"$7$?(B
  90. ;;; $BItJ,$rDI2C$7$?!#!J$3$NItJ,$O>-Mh:F=$@5$9$kM=Dj!#!K(B
  91.  
  92. ;;; 93.6.19  modified by T.Shingu <shingu@cpr.canon.co.jp>
  93. ;;; egg:*in-fence-mode* should be buffer local.
  94.  
  95. ;;; 93.6.4   modified by T.Shingu <shingu@cpr.canon.co.jp>
  96. ;;; In its-defrule**, length is called instead of chars-in-string.
  97.  
  98. ;;; 93.3.15  modified by T.Enami <enami@sys.ptg.sony.co.jp>
  99. ;;; egg-self-insert-command simulates the original more perfectly.
  100.  
  101. ;;; 92.12.20 modified by S.Tomura <tomura@etl.go.jp>
  102. ;;; In its:simulate-input, sref is called instead of aref.
  103.  
  104. ;;; 92.12.20 modified by T.Enami <enami@sys.ptg.sony.co.jp>
  105. ;;; egg-self-insert-command calls cancel-undo-boundary to simulate original.
  106.  
  107. ;;; 92.11.4 modified by M.Higashida <manabu@sigmath.osaka-u.ac.jp>
  108. ;;; read-hiragana-string sets minibuffer-preprompt correctly.
  109.  
  110. ;;; 92.10.26, 92.10.30 modified by T.Saneto sanewo@pdp.crl.sony.co.jp
  111. ;;; typo fixed.
  112.  
  113. ;;; 92.10.18 modified by K. Handa <handa@etl.go.jp>
  114. ;;; special-symbol-input $BMQ$N%F!<%V%k$r(B autoload $B$K!#(B
  115. ;;; busyu.el $B$N(B autoload $B$N;XDj$r(B mule-init.el $B$+$i(B egg.el $B$K0\$9!#(B
  116.  
  117. ;;;  92.9.20 modified by S. Tomura
  118. ;;;; hiragana-region $B$NCn$N=$@5(B
  119.  
  120. ;;;; 92.9.19 modified by Y. Kawabe
  121. ;;;; some typos
  122.  
  123. ;;;; 92.9.19 modified by Y. Kawabe<kawabe@sramhc.sra.co.jp>
  124. ;;;; menu $B$NI=<(4X78$N(B lenght $B$r(B string-width $B$KCV$-49$($k!%(B
  125.  
  126. ;;; 92.8.19 modified for Mule Ver.0.9.6 by K.Handa <handa@etl.go.jp>
  127. ;;;; menu:select-from-menu calls string-width instead of length.
  128.  
  129. ;;;; 92.8.1 modified by S. Tomura
  130. ;;;; internal mode $B$rDI2C!%(Bits:*internal-mode-alist* $BDI2C!%(B
  131.  
  132. ;;;; 92.7.31 modified by S. Tomura
  133. ;;;; its-mode-map $B$,(B super mode map $B$r;}$D$h$&$KJQ99$7$?!%$3$l$K$h$j(B 
  134. ;;;; mode map $B$,6&M-$G$-$k!%(B its-define-mode, get-next-map $B$J$I$rJQ99!%(B 
  135. ;;;; get-next-map-locally $B$rDI2C!%(Bits-defrule** $B$rJQ99!%(B
  136.  
  137. ;;;; 92.7.31 modified by S. Tomura
  138. ;;;; its:make-kanji-buffer , its:*kanji* $B4XO"%3!<%I$r:o=|$7$?!%(B
  139.  
  140. ;;;; 92.7.31 modified by S. Tomura
  141. ;;;;  egg:select-window-hook $B$r=$@5$7!$(Bminibuffer $B$+$i(B exit $B$9$k$H$-$K!$(B 
  142. ;;;; $B3F<oJQ?t$r(B default-value $B$KLa$9$h$&$K$7$?!%$3$l$K$h$C$F(B 
  143. ;;;; minibufffer $B$KF~$kA0$K3F<o@_Dj$,2DG=$H$J$k!%(B
  144.  
  145. ;;; 92.7.14  modified for Mule Ver.0.9.5 by T.Ito <toshi@his.cpl.melco.co.jp>
  146. ;;;    Attribute bold can be used.
  147. ;;;    Unnecessary '*' in comments of variables deleted.
  148. ;;; 92.7.8   modified for Mule Ver.0.9.5 by Y.Kawabe <kawabe@sra.co.jp>
  149. ;;;    special-symbol-input keeps the position selected last.
  150. ;;; 92.7.8   modified for Mule Ver.0.9.5 by T.Shingu <shingu@cpr.canon.co.jp>
  151. ;;;    busyu-input and kakusuu-input are added in *symbol-input-menu*.
  152. ;;; 92.7.7   modified for Mule Ver.0.9.5 by K.Handa <handa@etl.go.jp>
  153. ;;;    In egg:quit-mode, overwrite-mode is supported correctly.
  154. ;;;    egg:*overwrite-mode-deleted-chars* is not used now.
  155. ;;; 92.6.26  modified for Mule Ver.0.9.5 by K.Handa <handa@etl.go.jp>
  156. ;;;    Funtion dump-its-mode-map gets obsolete.
  157. ;;; 92.6.26  modified for Mule Ver.0.9.5 by M.Shikida <shikida@cs.titech.ac.jp>
  158. ;;;    Backquote ` is registered in *hankaku-alist* and *zenkaku-alist*.
  159. ;;; 92.6.17  modified for Mule Ver.0.9.5 by T.Shingu <shingu@cpr.canon.co.jp>
  160. ;;;    Bug in make-jis-second-level-code-alist fixed.
  161. ;;; 92.6.14  modified for Mule Ver.0.9.5 by T.Enami <enami@sys.ptg.sony.co.jp>
  162. ;;;    menu:select-from-menu is replaced with new version.
  163. ;;; 92.5.18  modified for Mule Ver.0.9.4 by T.Shingu <shingu@cpr.canon.co.jp>
  164. ;;;    lisp/wnn-egg.el is devided into two parts: this file and wnn*-egg.el.
  165.  
  166. ;;;;
  167. ;;;; Mule Ver.0.9.3 $B0JA0(B
  168. ;;;;
  169.  
  170. ;;;; April-15-92 for Mule Ver.0.9.3
  171. ;;;;    by T.Enami <enami@sys.ptg.sony.co.jp> and K.Handa <handa@etl.go.jp>
  172. ;;;;    notify-internal calls 'message' with correct argument.
  173.  
  174. ;;;; April-11-92 for Mule Ver.0.9.3
  175. ;;;;    by T.Enami <enami@sys.ptg.sony.co.jp> and K.Handa <handa@etl.go.jp>
  176. ;;;;    minibuffer $B$+$iH4$1$k;~(B egg:select-window-hook $B$G(B egg:*input-mode* $B$r(B
  177. ;;;;    t $B$K$9$k!#(Bhook $B$N7A$rBgI}=$@5!#(B
  178.  
  179. ;;;; April-3-92 for Mule Ver.0.9.2 by T.Enami <enami@sys.ptg.sony.co.jp>
  180. ;;;; minibuffer $B$+$iH4$1$k;~(B egg:select-window-hook $B$,(B new-buffer $B$N(B
  181. ;;;; egg:*mode-on* $B$J$I$r(B nil $B$K$7$F$$$k$N$r=$@5!#(B
  182.  
  183. ;;;; Mar-22-92 by K.Handa
  184. ;;;; etags $B$,:n$k(B TAGS $B$KITI,MW$J$b$N$rF~$l$J$$$h$&$K$9$k$?$a4X?tL>JQ99(B
  185. ;;;; define-its-mode -> its-define-mode, defrule -> its-defrule
  186.  
  187. ;;;; Mar-16-92 by K.Handa
  188. ;;;; global-map $B$X$N(B define-key $B$r(B mule-keymap $B$KJQ99!#(B
  189.  
  190. ;;;; Mar-13-92 by K.Handa
  191. ;;;; Language specific part $B$r(B japanese.el,... $B$K0\$7$?!#(B
  192.  
  193. ;;;; Feb-*-92 by K. Handa
  194. ;;;; nemacs 4 $B$G$O(B minibuffer-window-selected $B$,GQ;_$K$J$j!$4XO"$9$k%3!<%I$r:o=|$7$?!%(B
  195.  
  196. ;;;; Jan-13-92 by S. Tomura
  197. ;;;; mc-emacs or nemacs 4 $BBP1~:n6H3+;O!%(B
  198.  
  199. ;;;; Aug-9-91 by S. Tomura
  200. ;;;; ?\^ $B$r(B ?^ $B$K=$@5!%(B
  201.  
  202. ;;;;  menu $B$r(B key map $B$r8+$k$h$&$K$9$k!%(B
  203.  
  204. ;;;;  Jul-6-91 by S. Tomura
  205. ;;;;  setsysdict $B$N(B error $B%a%C%;!<%8$rJQ99!%(B
  206.  
  207. ;;;;  Jun-11-91 by S. Tomura
  208. ;;;;  its:*defrule-verbose* $B$rDI2C!%(B
  209. ;;;;
  210.  
  211. ;;;;  Mar-25-91 by S. Tomura
  212. ;;;;  reset-its-mode $B$rGQ;_(B
  213.  
  214. ;;;;  Mar-23-91 by S. Tomura
  215. ;;;;  read-hiragana-string $B$r=$@5!$(B read-kanji-string $B$rDI2C!$(B
  216. ;;;;  isearch:read-kanji-string $B$r@_Dj!%(B
  217.  
  218. ;;;;  Mar-22-91 by S. Tomura
  219. ;;;;  defrule-conditional, defrule-select-mode-temporally $B$rDI2C!#(B
  220. ;;;;  for-each $B$N4J0WHG$H$7$F(B dolist $B$rDI2C!#(B
  221. ;;;;  enable-double-n-syntax $B$r3hMQ!%$[$+$K(B use-kuten-for-comma, use-touten-for-period $B$rDI2C(B
  222.  
  223. ;;;;  Mar-5-91 by S. Tomura
  224. ;;;;  roma-kana-word, henkan-word, roma-kanji-word $B$rDI2C$7$?!%(B
  225.  
  226. ;;;;  Jan-14-91 by S. Tomura
  227. ;;;;  $BF~NOJ8;zJQ497O(B ITS(Input character Translation System) $B$r2~B$$9$k!%(B
  228. ;;;;  $BJQ49$O:G:8:GD9JQ49$r9T$J$$!$JQ49$N$J$$$b$N$O$b$H$N$^$^$H$J$k!%(B
  229. ;;;;  $B2~B$$NF05!$ON)LZ!w7D1~$5$s$N%O%s%0%kJ8;z$NF~NOMW5a$G$"$k!%(B
  230. ;;;;  its:* $B$rDI2C$7$?!%$^$?=>Mh(B fence-self-insert-command $B$H(B roma-kana-region 
  231. ;;;;  $BFs2U=j$K$o$+$l$F$$$?%3!<%I$r(B its:translate-region $B$K$h$C$F0lK\2=$7$?!%(B
  232.  
  233. ;;;;  July-30-90 by S. Tomura
  234. ;;;;  henkan-region $B$r(Boverwrite-mode $B$KBP1~$5$;$k!%JQ?t(B 
  235. ;;;;  egg:*henkan-fence-mode*, egg:*overwrite-mode-deleted-chars*
  236. ;;;;  $B$rDI2C$7!$(Bhenkan-fence-region, henkan-region-internal, 
  237. ;;;;  quit-egg-mode $B$rJQ99$9$k!%(B
  238.  
  239. ;;;;  Mar-4-90 by K.Handa
  240. ;;;;  New variable alphabet-mode-indicator, transparent-mode-indicator,
  241. ;;;;  and henkan-mode-indicator.
  242.  
  243. ;;;;  Feb-27-90 by enami@ptgd.sony.co.jp
  244. ;;;;  menu:select-from-menu $B$G#22U=j$"$k(B ((and (<= ?0 ch) (<= ch ?9)...
  245. ;;;;  $B$N0lJ}$r(B ((and (<= ?0 ch) (<= ch ?9)... $B$K=$@5(B
  246.  
  247. ;;;;  Feb-07-89
  248. ;;;;  bunsetu-length-henko $B$NCf$N(B egg:*attribute-off $B$N0LCV$r(B KKCP $B$r8F$VA0$K(B
  249. ;;;;  $BJQ99$9$k!#(B wnn-client $B$G$O(B KKCP $B$r8F$V$HJ8@a>pJs$,JQ2=$9$k!#(B
  250.  
  251. ;;;;  Feb-01-89
  252. ;;;;  henkan-goto-kouho $B$N(B egg:set-bunsetu-attribute $B$N0z?t(B
  253. ;;;;  $B$N=gHV$,4V0c$C$F$$$?$N$r=$@5$7$?!#!J(Btoshi@isvax.isl.melco.co.jp
  254. ;;;;  (Toshiyuki Ito)$B$N;XE&$K$h$k!#!K(B
  255.  
  256. ;;;;  Dec-25-89
  257. ;;;;  meta-flag t $B$N>l9g$NBP1~$r:F=$@5$9$k!#(B
  258. ;;;;  overwrite-mode $B$G$N(B undo $B$r2~A1$9$k!#(B
  259.  
  260. ;;;;  Dec-21-89
  261. ;;;;  bug fixed by enami@ptdg.sony.co.jp
  262. ;;;;     (fboundp 'minibuffer-window-selected )
  263. ;;;;  -->(boundp  'minibuffer-window-selected )
  264. ;;;;  self-insert-after-hook $B$r(B buffer local $B$K$7$FDj5A$r(B kanji.el $B$X0\F0!#(B
  265.  
  266. ;;;;  Dec-15-89
  267. ;;;;  kill-all-local-variables $B$NDj5A$r(B kanji.el $B$X0\F0$9$k!#(B
  268.  
  269. ;;;;  Dec-14-89
  270. ;;;;  meta-flag t $B$N>l9g$N=hM}$r=$@5$9$k(B
  271. ;;;;  overwrite-mode $B$KBP1~$9$k!#(B
  272.  
  273. ;;;;  Dec-12-89
  274. ;;;;  egg:*henkan-open*, egg:*henkan-close* $B$rDI2C!#(B
  275. ;;;;  egg:*henkan-attribute* $B$rDI2C(B
  276. ;;;;  set-egg-fence-mode-format, set-egg-henkan-mode-format $B$rDI2C(B
  277.  
  278. ;;;;  Dec-12-89
  279. ;;;;  *bunpo-code* $B$K(B 1000: "$B$=$NB>(B" $B$rDI2C(B
  280.  
  281. ;;;;  Dec-11-89
  282. ;;;;  egg:*fence-attribute* $B$r?7@_(B
  283. ;;;;  egg:*bunsetu-attribute* $B$r?7@_(B
  284.  
  285. ;;;;  Dec-11-89
  286. ;;;;  attribute-*-region $B$rMxMQ$9$k$h$&$KJQ99$9$k!#(B
  287. ;;;;  menu:make-selection-list $B$O(B width $B$,>.$5$$;~$K(Bloop $B$9$k!#$3$l$r=$@5$7$?!#(B
  288.  
  289. ;;;;  Dec-10-89
  290. ;;;;  set-marker-type $B$rMxMQ$9$kJ}<0$KJQ99!#(B
  291.  
  292. ;;;;  Dec-07-89
  293. ;;;;  egg:search-path $B$rDI2C!#(B
  294. ;;;;  egg-default-startup-file $B$rDI2C$9$k!#(B
  295.  
  296. ;;;;  Nov-22-89
  297. ;;;;  egg-startup-file $B$rDI2C$9$k!#(B
  298. ;;;;  eggrc-search-path $B$r(B egg-startup-file-search-path $B$KL>A0JQ99!#(B
  299.  
  300. ;;;;  Nov-21-89
  301. ;;;;  Nemacs 3.2 $B$KBP1~$9$k!#(Bkanji-load* $B$rGQ;_$9$k!#(B
  302. ;;;;  wnnfns.c $B$KBP1~$7$?=$@5$r2C$($k!#(B
  303. ;;;;  *Notification* buffer $B$r8+$($J$/$9$k!#(B
  304.  
  305. ;;;;  Oct-2-89
  306. ;;;;  *zenkaku-alist* $B$N(B $BJ8;zDj?t$N=q$-J}$,4V0c$C$F$$$?!#(B
  307.  
  308. ;;;;  Sep-19-89
  309. ;;;;  toggle-egg-mode $B$N=$@5!J(Bkanji-flag$B!K(B
  310. ;;;;  egg-self-insert-command $B$N=$@5(B $B!J(Bkanji-flag$B!K(B
  311.  
  312. ;;;;  Sep-18-89
  313. ;;;;  self-insert-after-hook $B$NDI2C(B
  314.  
  315. ;;;;  Sep-15-89
  316. ;;;;  EGG:open-wnn bug fix
  317. ;;;;  provide wnn-egg feature
  318.  
  319. ;;;;  Sep-13-89
  320. ;;;;  henkan-kakutei-before-point $B$r=$@5$7$?!#(B
  321. ;;;;  enter-fence-mode $B$NDI2C!#(B
  322. ;;;;  egg-exit-hook $B$NDI2C!#(B
  323. ;;;;  henkan-region-internal $B$NDI2C!#(Bhenkan-region$B$O(B point $B$r(Bmark $B$9$k!#(B
  324. ;;;;  eggrc-search-path $B$NDI2C!#(B
  325.  
  326. ;;;;  Aug-30-89
  327. ;;;;  kanji-kanji-1st $B$rD{@5$7$?!#(B
  328.  
  329. ;;;;  May-30-89
  330. ;;;;  EGG:open-wnn $B$O(B get-wnn-host-name $B$,(B nil $B$N>l9g!"(B(system-name) $B$r;HMQ$9$k!#(B
  331.  
  332. ;;;;  May-9-89
  333. ;;;;  KKCP:make-directory added.
  334. ;;;;  KKCP:file-access bug fixed.
  335. ;;;;  set-default-usr-dic-directory modified.
  336.  
  337. ;;;;  Mar-16-89
  338. ;;;;  minibuffer-window-selected $B$r;H$C$F(B minibuffer $B$N(B egg-mode$BI=<(5!G=DI2C(B
  339.  
  340. ;;;;  Mar-13-89
  341. ;;;;   mode-line-format changed. 
  342.  
  343. ;;;;  Feb-27-89
  344. ;;;;  henkan-saishou-bunsetu added
  345. ;;;;  henkan-saichou-bunsetu added
  346. ;;;;  M-<    henkan-saishou-bunsetu
  347. ;;;;  M->    henkan-saichou-bunsetu
  348.  
  349. ;;;;  Feb-14-89
  350. ;;;;   C-h in henkan mode: help-command added
  351.  
  352. ;;;;  Feb-7-89
  353. ;;;;   egg-insert-after-hook is added.
  354.  
  355. ;;;;   M-h   fence-hiragana
  356. ;;;;   M-k   fence-katakana
  357. ;;;;   M->   fence-zenkaku
  358. ;;;;   M-<   fence-hankaku
  359.  
  360. ;;;;  Dec-19-88 henkan-hiragana, henkan-katakara$B$rDI2C!'(B
  361. ;;;;    M-h     henkan-hiragana
  362. ;;;;    M-k     henkan-katakana
  363.  
  364. ;;;;  Ver. 2.00 kana2kanji.c $B$r;H$o$:(B wnn-client.el $B$r;HMQ$9$k$h$&$KJQ99!#(B
  365. ;;;;            $B4XO"$7$F0lIt4X?t$rJQ99(B
  366.  
  367. ;;;;  Dec-2-88 special-symbol-input $B$rDI2C!((B
  368. ;;;;    C-^   special-symbol-input
  369.  
  370. ;;;;  Nov-18-88 henkan-mode-map $B0lItJQ99!((B
  371. ;;;;    M-i  henkan-inspect-bunsetu
  372. ;;;;    M-s  henkan-select-kouho
  373. ;;;;    C-g  henkan-quit
  374.  
  375. ;;;;  Nov-18-88 jserver-henkan-kakutei $B$N;EMMJQ99$KH<$$!"(Bkakutei $B$N%3!<(B
  376. ;;;;  $B%I$rJQ99$7$?!#(B
  377.  
  378. ;;;;  Nov-17-88 kakutei-before-point $B$G(B point $B0J9_$N4V0c$C$?ItJ,$NJQ49(B
  379. ;;;;  $B$,IQEY>pJs$KEPO?$5$l$J$$$h$&$K=$@5$7$?!#$3$l$K$O(BKKCC:henkan-end 
  380. ;;;;  $B$N0lIt;EMM$HBP1~$9$k(Bkana2kanji.c$B$bJQ99$7$?!#(B
  381.  
  382. ;;;;  Nov-17-88 henkan-inspect-bunsetu $B$rDI2C$7$?!#(B
  383.  
  384. ;;;;  Nov-17-88 $B?7$7$$(B kana2kanji.c $B$KJQ99$9$k!#(B
  385.  
  386. ;;;;  Sep-28-88 defrule$B$,CM$H$7$F(Bnil$B$rJV$9$h$&$KJQ99$7$?!#(B
  387.  
  388. ;;;;  Aug-25-88 $BJQ493X=,$r@5$7$/9T$J$&$h$&$KJQ99$7$?!#(B
  389. ;;;;  KKCP:henkan-kakutei$B$O(BKKCP:jikouho-list$B$r8F$s$@J8@a$KBP$7$F$N$_E,(B
  390. ;;;;  $BMQ$G$-!"$=$l0J30$N>l9g$N7k2L$OJ]>Z$5$l$J$$!#$3$N>r7o$rK~$?$9$h$&(B
  391. ;;;;  $B$K(BKKCP:jikouho-list$B$r8F$s$G$$$J$$J8@a$KBP$7$F$O(B
  392. ;;;;  KKCP:henkan-kakutei$B$r8F$P$J$$$h$&$K$7$?!#(B
  393.  
  394. ;;;;  Aug-25-88 egg:do-auto-fill $B$r=$@5$7!"J#?t9T$K$o$?$k(Bauto-fill$B$r@5(B
  395. ;;;;  $B$7$/9T$J$&$h$&$K=$@5$7$?!#(B
  396.  
  397. ;;;;  Aug-25-88 menu command$B$K(B\C-l: redraw $B$rDI2C$7$?!#(B
  398.  
  399. ;;;;  Aug-25-88 toroku-region$B$GEPO?$9$kJ8;zNs$+$i(Bno graphic character$B$r(B
  400. ;;;;  $B<+F0E*$K=|$/$3$H$K$7$?!#(B
  401.  
  402. ;; XEmacs addition: (and remove disable-undo variable)
  403. ;; For Emacs V18/Nemacs compatibility
  404. ;(and (not (fboundp 'buffer-disable-undo))
  405. ;     (fboundp 'buffer-flush-undo)
  406. ;     (defalias 'buffer-disable-undo 'buffer-flush-undo))
  407.  
  408. ;; 97.2.4 Created by J.Hein to simulate Mule-2.3
  409. (defun egg-read-event ()
  410.   "FSFmacs event emulator that shoves non key events into
  411. unread-command-events to facilitate translation from Mule-2.3"
  412.   (let ((event (make-event))
  413.     ch key)
  414.     (next-command-event event)
  415.     (setq key (event-key event))
  416.     (if (and (key-press-event-p event) 
  417.          (not (event-matches-key-specifier-p event 'backspace)))
  418.     (if (eq 0 (event-modifier-bits event))
  419.         (setq ch (or (event-to-character event) key))
  420.       (if (eq 1 (event-modifier-bits event))
  421.           (setq ch
  422.             (if (characterp key)
  423.             (or (int-to-char (- (char-to-int key) 96))
  424.                 (int-to-char (- (char-to-int key) 64)))
  425.               (event-to-character event)))
  426.         (setq unread-command-events (list event))))
  427.       (setq unread-command-events (list event)))
  428.     ch))
  429.  
  430. (eval-when-compile (require 'egg-jsymbol))
  431.  
  432. ;;;
  433. ;;;----------------------------------------------------------------------
  434. ;;;
  435. ;;; Utilities
  436. ;;;
  437. ;;;----------------------------------------------------------------------
  438.  
  439. ;;; 
  440. ;;;;
  441.  
  442. (defun coerce-string (form)
  443.   (cond((stringp form) form)
  444.        ((characterp form) (char-to-string form))))
  445.  
  446. (defun coerce-internal-string (form)
  447.   (cond((stringp form)
  448.     (if (= (length form) 1) 
  449.         (string-to-char form)
  450.       form))
  451.        ((characterp form) form)))
  452.  
  453. ;;; kill-all-local-variables $B$+$iJ]8n$9$k(B local variables $B$r;XDj$G$-$k(B
  454. ;;; $B$h$&$KJQ99$9$k!#(B
  455.  
  456. (put 'egg:*input-mode* 'permanent-local t)
  457. (put 'egg:*mode-on* 'permanent-local t)
  458. (put 'its:*current-map* 'permanent-local t)
  459. (put 'mode-line-egg-mode 'permanent-local t)
  460.  
  461. ;;;----------------------------------------------------------------------
  462. ;;;
  463. ;;; 16$B?JI=8=$N(BJIS $B4A;z%3!<%I$r(B minibuffer $B$+$iFI$_9~$`(B
  464. ;;;
  465. ;;;----------------------------------------------------------------------
  466.  
  467. ;;;
  468. ;;; User entry:  jis-code-input
  469. ;;;
  470.  
  471. (defun jis-code-input ()
  472.   (interactive)
  473.   (insert-jis-code-from-minibuffer "JIS $B4A;z%3!<%I(B(16$B?J?tI=8=(B): "))
  474.  
  475. (defun insert-jis-code-from-minibuffer (prompt)
  476.   (let ((str (read-from-minibuffer prompt)) val)
  477.     (while (null (setq val (read-jis-code-from-string str)))
  478.       (beep)
  479.       (setq str (read-from-minibuffer prompt str)))
  480.     (insert (make-char (find-charset 'japanese-jisx0208) (car val) (cdr val)))))
  481.  
  482. (defun hexadigit-value (ch)
  483.   (cond((and (<= ?0 ch) (<= ch ?9))
  484.     (- ch ?0))
  485.        ((and (<= ?a ch) (<= ch ?f))
  486.     (+ (- ch ?a) 10))
  487.        ((and (<= ?A ch) (<= ch ?F))
  488.     (+ (- ch ?A) 10))))
  489.  
  490. (defun read-jis-code-from-string (str)
  491.   (if (and (= (length str) 4)
  492.        (<= 2 (hexadigit-value (aref str 0)))
  493.        (hexadigit-value (aref str 1))
  494.        (<= 2 (hexadigit-value (aref str 2)))
  495.        (hexadigit-value (aref str 3)))
  496.   (cons (+ (* 16 (hexadigit-value (aref str 0)))
  497.            (hexadigit-value (aref str 1)))
  498.     (+ (* 16 (hexadigit-value (aref str 2)))
  499.        (hexadigit-value (aref str 3))))))
  500.  
  501. ;;;----------------------------------------------------------------------    
  502. ;;;
  503. ;;; $B!V$?$^$4!W(B Notification System
  504. ;;;
  505. ;;;----------------------------------------------------------------------
  506.  
  507. (defconst *notification-window* " *Notification* ")
  508.  
  509. ;;;(defmacro notify (str &rest args)
  510. ;;;  (list 'notify-internal
  511. ;;;    (cons 'format (cons str args))))
  512.  
  513. (defun notify (str &rest args)
  514.   (notify-internal (apply 'format (cons str args))))
  515.  
  516. (defun notify-internal (message &optional noerase)
  517.   (save-excursion
  518.     (let ((notify-buff (get-buffer-create *notification-window*)))
  519.       (set-buffer notify-buff)
  520.       (goto-char (point-max))
  521.       (setq buffer-read-only nil)
  522.       (insert (substring (current-time-string) 4 19) ":: " message ?\n )
  523.       (setq buffer-read-only t)
  524.       (bury-buffer notify-buff)
  525.       (message "%s" message)        ; 92.4.15 by T.Enami
  526.       (if noerase nil
  527.     (sleep-for 1) (message "")))))
  528.  
  529. ;;;(defmacro notify-yes-or-no-p (str &rest args)
  530. ;;;  (list 'notify-yes-or-no-p-internal 
  531. ;;;    (cons 'format (cons str args))))
  532.  
  533. (defun notify-yes-or-no-p (str &rest args)
  534.   (notify-yes-or-no-p-internal (apply 'format (cons str args))))
  535.  
  536. (defun notify-yes-or-no-p-internal (message)
  537.   (save-window-excursion
  538.     (pop-to-buffer *notification-window*)
  539.     (goto-char (point-max))
  540.     (setq buffer-read-only nil)
  541.     (insert (substring (current-time-string) 4 19) ":: " message ?\n )
  542.     (setq buffer-read-only t)
  543.     (yes-or-no-p "$B$$$$$G$9$+!)(B")))
  544.  
  545. (defun notify-y-or-n-p (str &rest args)
  546.   (notify-y-or-n-p-internal (apply 'format (cons str args))))
  547.  
  548. (defun notify-y-or-n-p-internal (message)
  549.   (save-window-excursion
  550.     (pop-to-buffer *notification-window*)
  551.     (goto-char (point-max))
  552.     (setq buffer-read-only nil)
  553.     (insert (substring (current-time-string) 4 19) ":: " message ?\n )
  554.     (setq buffer-read-only t)
  555.     (y-or-n-p "$B$$$$$G$9$+!)(B")))
  556.  
  557. (defun select-notification ()
  558.   (interactive)
  559.   (pop-to-buffer *notification-window*)
  560.   (setq buffer-read-only t))
  561.  
  562. ;;;----------------------------------------------------------------------
  563. ;;;
  564. ;;; $B!V$?$^$4!W(B Menu System
  565. ;;;
  566. ;;;----------------------------------------------------------------------
  567.  
  568. ;;;
  569. ;;;  minibuffer $B$K(B menu $B$rI=<(!&A*Br$9$k(B
  570. ;;;
  571.  
  572. ;;;
  573. ;;; menu $B$N;XDjJ}K!!'(B
  574. ;;;
  575. ;;; <menu item> ::= ( menu <prompt string>  <menu-list> )
  576. ;;; <menu list> ::= ( <menu element> ... )
  577. ;;; <menu element> ::= ( <string> . <value> ) | <string>
  578. ;;;                    ( <char>   . <value> ) | <char>
  579.  
  580. ;;; select-menu-in-minibuffer
  581.  
  582. (defvar menu:*select-items* nil)
  583. (defvar menu:*select-menus* nil)
  584. (defvar menu:*select-item-no* nil)
  585. (defvar menu:*select-menu-no* nil)
  586. (defvar menu:*select-menu-stack* nil)
  587. (defvar menu:*select-start* nil)
  588. (defvar menu:*select-positions* nil)
  589.  
  590. (defvar menu-mode-map (make-keymap))
  591.  
  592. (define-key menu-mode-map "\C-a" 'menu:begining-of-menu)
  593. (define-key menu-mode-map "\C-e" 'menu:end-of-menu)
  594. (define-key menu-mode-map "\C-f" 'menu:next-item)
  595. (define-key menu-mode-map "\C-b" 'menu:previous-item)
  596. (define-key menu-mode-map "\C-n" 'menu:next-item-old)
  597. (define-key menu-mode-map "\C-g" 'menu:quit)
  598. (define-key menu-mode-map "\C-p" 'menu:previous-item-old)
  599. (define-key menu-mode-map "\C-l" 'menu:refresh)
  600. ;;; 0 .. 9 a .. z A .. z
  601. (define-key menu-mode-map "\C-m" 'menu:select)
  602. (define-key menu-mode-map [return] 'menu:select)
  603. (define-key menu-mode-map [left] 'menu:previous-item)
  604. (define-key menu-mode-map [right] 'menu:next-item)
  605. (define-key menu-mode-map [up] 'menu:previous-item-old)
  606. (define-key menu-mode-map [down] 'menu:next-item-old)
  607.  
  608. ;; 92.6.14 by T.Enami -- This function was completely modified.
  609. (defun menu:select-from-menu (menu &optional initial position)
  610.   (let ((echo-keystrokes 0)
  611.     (inhibit-quit t)
  612.     (menubuffer (get-buffer-create " *menu*"))
  613.     (minibuffer (window-buffer (minibuffer-window)))
  614.     value)
  615.     (save-window-excursion
  616.       (set-window-buffer (minibuffer-window) menubuffer)
  617.       (select-window (minibuffer-window))
  618.       (set-buffer menubuffer)
  619.       (delete-region (point-min) (point-max))
  620.       (insert (nth 1 menu))
  621.       (let* ((window-width (window-width (selected-window)))
  622.          (finished nil))
  623.     (setq menu:*select-menu-stack* nil
  624.           menu:*select-positions* nil
  625.           menu:*select-start* (point)
  626.           menu:*select-menus*
  627.           (menu:make-selection-list (nth 2 menu)
  628.                     (- window-width  
  629.                        ;;; 92.8.19 by K.Handa
  630.                        (string-width (nth 1 menu)))))
  631.     ;; 92.7.8 by Y.Kawabe
  632.     (cond
  633.      ((and (numberp initial)
  634.            (<= 0 initial)
  635.            (< initial (length (nth 2 menu))))
  636.       (menu:select-goto-item-position initial))
  637.      ((and (listp initial) (car initial)
  638.            (<= 0 (car initial))
  639.            (< (car initial) (length (nth 2 menu))))
  640.       (menu:select-goto-item-position (car initial))
  641.       (while (and (setq initial (cdr initial))
  642.               (setq value (menu:item-value (nth menu:*select-item-no* 
  643.                             menu:*select-items*)))
  644.               (listp value) (eq (car value) 'menu))
  645.         (setq menu:*select-positions*
  646.           (cons (menu:select-item-position) menu:*select-positions*))
  647.         (setq menu:*select-menu-stack*
  648.           (cons (list menu:*select-items* menu:*select-menus*
  649.                   menu:*select-item-no* menu:*select-menu-no*
  650.                   menu)
  651.             menu:*select-menu-stack*))
  652.         (setq menu value)
  653.         (delete-region (point-min) (point-max)) (insert (nth 1 menu))
  654.         (setq menu:*select-start* (point))
  655.         (setq menu:*select-menus*
  656.           (menu:make-selection-list
  657.            ;;; 92.9.19 by Y. Kawabe
  658.            (nth 2 menu) (- window-width (string-width (nth 1 menu)))))
  659.         (if (and (numberp (car initial))
  660.              (<= 0 (car initial))
  661.              (< (car initial) (length (nth 2 menu))))
  662.         (menu:select-goto-item-position (car initial))
  663.           (setq menu:*select-item-no* 0)
  664.           (menu:select-goto-menu 0)))
  665.       (setq value nil))
  666.      (t
  667.       (setq menu:*select-item-no* 0)
  668.       (menu:select-goto-menu 0))
  669.      )
  670.     ;; end of patch
  671.     (while (not finished)
  672.       (let ((ch (egg-read-event)))
  673.         (setq quit-flag nil)
  674.         (cond
  675.          ((eq ch ?\C-a)
  676.           (menu:select-goto-item 0))
  677.          ((eq ch ?\C-e)
  678.           (menu:select-goto-item (1- (length menu:*select-items*))))
  679.          ((or (eq ch ?\C-f) (eq ch 'right))
  680.           ;;(menu:select-goto-item (1+ menu:*select-item-no*))
  681.           (menu:select-next-item)
  682.           )
  683.          ((or (eq ch ?\C-b) (eq ch 'left))
  684.           ;;(menu:select-goto-item (1- menu:*select-item-no*))
  685.           (menu:select-previous-item)
  686.           )
  687.          ((or (eq ch ?\C-n) (eq ch 'down))
  688.           (menu:select-goto-menu (1+ menu:*select-menu-no*)))
  689.          ((eq ch ?\C-g)
  690.           (if menu:*select-menu-stack*
  691.           (let ((save (car menu:*select-menu-stack*)))
  692.             (setq menu:*select-menu-stack*
  693.               (cdr menu:*select-menu-stack*))
  694.             (setq menu:*select-items* (nth 0 save);92.10.26 by T.Saneto
  695.               menu:*select-menus*    (nth 1 save)
  696.               menu:*select-item-no*  (nth 2 save)
  697.               menu:*select-menu-no*  (nth 3 save)
  698.               menu                   (nth 4 save))
  699.             (setq menu:*select-positions*
  700.               (cdr menu:*select-positions*))
  701.             (delete-region (point-min) (point-max))
  702.             (insert (nth 1 menu))
  703.             (setq menu:*select-start* (point))
  704.             (menu:select-goto-menu menu:*select-menu-no*)
  705.             (menu:select-goto-item menu:*select-item-no*)
  706.             )
  707.         (setq finished t
  708.               value nil)))
  709.          ((or (eq ch ?\C-p) (eq ch 'up))
  710.           (menu:select-goto-menu (1- menu:*select-menu-no*)))
  711.          ((eq ch ?\C-l)  ;;; redraw menu
  712.           (menu:select-goto-menu menu:*select-menu-no*))
  713.          ((and (characterp ch) (<= ?0 ch) (<= ch ?9)
  714.            (<= ch (+ ?0 (1- (length menu:*select-items*)))))
  715.           (menu:select-goto-item (- ch ?0)))
  716.          ((and (characterp ch) (<= ?a ch) (<= ch ?z)
  717.            (<= (+ 10 ch) (+ ?a (1- (length menu:*select-items*)))))
  718.           (menu:select-goto-item (+ 10 (- ch ?a))))
  719.          ((and (characterp ch) (<= ?A ch) (<= ch ?Z)
  720.            (<= (+ 10 ch) (+ ?A (1- (length menu:*select-items*)))))
  721.           (menu:select-goto-item (+ 10 (- ch ?A))))
  722.          ((or (eq ch ?\C-m) (eq ch 'return))
  723.           (setq value (menu:item-value (nth menu:*select-item-no* 
  724.                         menu:*select-items*)))
  725.           (setq menu:*select-positions* 
  726.             (cons (menu:select-item-position)
  727.               menu:*select-positions*))
  728.           (if (and (listp value)
  729.                (eq (car value) 'menu))
  730.           (progn
  731.             (setq menu:*select-menu-stack*
  732.               (cons
  733.                (list menu:*select-items* menu:*select-menus*
  734.                  menu:*select-item-no* menu:*select-menu-no*
  735.                  menu)
  736.                menu:*select-menu-stack*))
  737.             (setq menu value)
  738.             (delete-region (point-min) (point-max))
  739.             (insert (nth 1 menu))
  740.             (setq menu:*select-start* (point))
  741.             (setq menu:*select-menus*
  742.               ;;; 92.9.19 by Y. Kawabe
  743.               (menu:make-selection-list
  744.                (nth 2 menu)
  745.                (- window-width
  746.                   (string-width (nth 1 menu)))))
  747.             (setq menu:*select-item-no* 0)
  748.             (menu:select-goto-menu 0)
  749.             (setq value nil)
  750.             )
  751.         (setq finished t)))
  752.          (t (beep))))))
  753.       (delete-region (point-min) (point-max))
  754.       (setq menu:*select-positions*
  755.         (nreverse menu:*select-positions*))
  756.       (set-window-buffer (minibuffer-window) minibuffer)
  757.       (if (null value)
  758.       (setq quit-flag t)
  759.     (if position
  760.         (cons value menu:*select-positions*)
  761.       value)))))
  762.  
  763. (defun menu:select-item-position ()
  764.   (let ((p 0) (m 0))
  765.     (while (< m menu:*select-menu-no*)
  766.       (setq p (+ p (length (nth m menu:*select-menus*))))
  767.       (setq m (1+ m)))
  768.     (+ p menu:*select-item-no*)))
  769.     
  770. (defun menu:select-goto-item-position (pos)
  771.   (let ((m 0) (p 0))
  772.     (while (<= (+ p (length (nth m menu:*select-menus*))) pos)
  773.       (setq p (+ p (length (nth m menu:*select-menus*))))
  774.       (setq m (1+ m)))
  775.     (setq menu:*select-item-no* (- pos p))
  776.     (menu:select-goto-menu m)))
  777.  
  778. (defun menu:select-goto-menu (no)
  779.   (setq menu:*select-menu-no*
  780.     (check-number-range no 0 (1- (length menu:*select-menus*))))
  781.   (setq menu:*select-items* (nth menu:*select-menu-no* menu:*select-menus*))
  782.   (delete-region menu:*select-start* (point-max))
  783.   (if (<= (length menu:*select-items*) menu:*select-item-no*)
  784.       (setq menu:*select-item-no* (1- (length menu:*select-items*))))
  785.   (goto-char menu:*select-start*)
  786.   (let ((l menu:*select-items*) (i 0))
  787.     (while l
  788.       (insert (if (<= i 9) (format "  %d." i)
  789.         (format "  %c." (+ (- i 10) ?a)))
  790.           (menu:item-string (car l)))
  791.       (setq l (cdr l)
  792.         i (1+ i))))
  793.   (menu:select-goto-item menu:*select-item-no*))
  794.  
  795. (defun menu:select-goto-item (no)
  796.   (setq menu:*select-item-no* 
  797.     (check-number-range no 0
  798.                 (1- (length menu:*select-items*))))
  799.   (let ((p (+ 2 menu:*select-start*)) (i 0))
  800.     (while (< i menu:*select-item-no*)
  801.       (setq p (+ p (length (menu:item-string (nth i menu:*select-items*))) 4))
  802.       (setq i (1+ i)))
  803.     (goto-char p)))
  804.     
  805. (defun menu:select-next-item ()
  806.   (if (< menu:*select-item-no* (1- (length menu:*select-items*)))
  807.       (menu:select-goto-item (1+ menu:*select-item-no*))
  808.     (progn
  809.       (setq menu:*select-item-no* 0)
  810.       (menu:select-goto-menu (1+ menu:*select-menu-no*)))))
  811.  
  812. (defun menu:select-previous-item ()
  813.   (if (< 0 menu:*select-item-no*)
  814.       (menu:select-goto-item (1- menu:*select-item-no*))
  815.     (progn 
  816.       (setq menu:*select-item-no* 1000)
  817.       (menu:select-goto-menu (1- menu:*select-menu-no*)))))
  818.  
  819. (defvar menu:*display-item-value* nil)
  820.  
  821. (defun menu:item-string (item)
  822.   (cond((stringp item) item)
  823.        ((characterp item) (char-to-string item))
  824.        ((consp item)
  825.     (if menu:*display-item-value*
  826.         (format "%s [%s]"
  827.             (cond ((stringp (car item)) (car item))
  828.               ((characterp (car item)) (char-to-string (car item)))
  829.               (t ""))
  830.             (cdr item))
  831.       (cond ((stringp (car item))
  832.          (car item))
  833.         ((characterp (car item))
  834.          (char-to-string (car item)))
  835.         (t ""))))
  836.        (t "")))
  837.  
  838. (defun menu:item-value (item)
  839.   (cond((stringp item) item)
  840.        (t (cdr item))))
  841.  
  842. (defun menu:make-selection-list (items width)
  843.   (let ((whole nil) (line nil) (size 0))
  844.     (while items
  845.       ;;; 92.9.19 by Y. Kawabe
  846.       (if (<= width (+ size 4 (string-width (menu:item-string(car items)))))
  847.       (if line
  848.           (setq whole (cons (reverse line) whole)
  849.             line nil
  850.             size 0)
  851.         (setq whole (cons (list (car items)) whole)
  852.           size 0
  853.           items (cdr items)))
  854.     ;;; 92.9.19 by Y. Kawabe
  855.     (setq line (cons (car items) line)
  856.           size (+ size 4 (string-width(menu:item-string (car items))))
  857.           items (cdr items))))
  858.     (if line
  859.     (reverse (cons (reverse line) whole))
  860.       (reverse whole))))
  861.  
  862.  
  863. ;;;----------------------------------------------------------------------
  864. ;;;
  865. ;;;  $B0l3g7?JQ495!G=(B
  866. ;;;
  867. ;;;----------------------------------------------------------------------
  868.  
  869.  
  870. ;;;
  871. ;;; $B$R$i$,$JJQ49(B
  872. ;;;
  873.  
  874. (defun hiragana-region (start end)
  875.   (interactive "r")
  876.     (goto-char start)
  877.     (while (re-search-forward kanji-katakana end end)
  878.       (let ((ch (char-before (point))))
  879.     (cond( (not (or (> ch ?$B%s(B)
  880.             (eq ch ?$B!<(B)
  881.             (eq ch ?$B!+(B)
  882.             (eq ch ?$B!,(B)))
  883.            (delete-char -1)
  884.            (insert (make-char (find-charset 'japanese-jisx0208) 36 (char-octet ch 1))))))))
  885.  
  886. (defun hiragana-paragraph ()
  887.   "hiragana  paragraph at or after point."
  888.   (interactive )
  889.   (save-excursion
  890.     (forward-paragraph)
  891.     (let ((end (point)))
  892.       (backward-paragraph)
  893.       (hiragana-region (point) end ))))
  894.  
  895. (defun hiragana-sentence ()
  896.   "hiragana  sentence at or after point."
  897.   (interactive )
  898.   (save-excursion
  899.     (forward-sentence)
  900.     (let ((end (point)))
  901.       (backward-sentence)
  902.       (hiragana-region (point) end ))))
  903.  
  904. ;;;
  905. ;;; $B%+%?%+%JJQ49(B
  906. ;;;
  907.  
  908. (defun katakana-region (start end)
  909.   (interactive "r")
  910.   (goto-char start)
  911.   (while (re-search-forward kanji-hiragana end end)
  912.     (let ((ch (char-before (point))))
  913.       (cond ((not (memq ch '(?$B!<(B ?$B!+(B ?$B!,(B)))
  914.          (delete-char -1)
  915.          (insert (make-char (find-charset 'japanese-jisx0208) 37 (char-octet ch 1))))))))
  916.  
  917. (defun katakana-paragraph ()
  918.   "katakana  paragraph at or after point."
  919.   (interactive )
  920.   (save-excursion
  921.     (forward-paragraph)
  922.     (let ((end (point)))
  923.       (backward-paragraph)
  924.       (katakana-region (point) end ))))
  925.  
  926. (defun katakana-sentence ()
  927.   "katakana  sentence at or after point."
  928.   (interactive )
  929.   (save-excursion
  930.     (forward-sentence)
  931.     (let ((end (point)))
  932.       (backward-sentence)
  933.       (katakana-region (point) end ))))
  934.  
  935. ;;;
  936. ;;; $BH>3QJQ49(B
  937. ;;; 
  938.  
  939. (defun hankaku-region (start end)
  940.   (interactive "r")
  941.   (save-restriction
  942.     (narrow-to-region start end)
  943.     (goto-char (point-min))
  944.     (while (re-search-forward "\\cS\\|\\cA\\|\\cK" (point-max) (point-max))
  945.       (let* ((ch (char-before (point)))
  946.          (ch1 (char-octet ch 0))
  947.          (ch2 (char-octet ch 1)))
  948.     (cond ((= ch1 33) ;Symbols
  949.            (let ((val (cdr (assq ch2 *hankaku-alist*))))
  950.          (if val (progn
  951.                (delete-char -1)
  952.                (insert val)))))
  953. ;          ((= ch1 37) ;Katakana
  954. ;           (delete-char -1)
  955. ;           (insert (- ch2 ?\200 )))
  956.           ((= ch1 35) ;Alphas
  957.            (delete-char -1)
  958.            (insert ch2)))))))
  959.  
  960. (defun hankaku-paragraph ()
  961.   "hankaku  paragraph at or after point."
  962.   (interactive )
  963.   (save-excursion
  964.     (forward-paragraph)
  965.     (let ((end (point)))
  966.       (backward-paragraph)
  967.       (hankaku-region (point) end ))))
  968.  
  969. (defun hankaku-sentence ()
  970.   "hankaku  sentence at or after point."
  971.   (interactive )
  972.   (save-excursion
  973.     (forward-sentence)
  974.     (let ((end (point)))
  975.       (backward-sentence)
  976.       (hankaku-region (point) end ))))
  977.  
  978. (defun hankaku-word (arg)
  979.   (interactive "p")
  980.   (let ((start (point)))
  981.     (forward-word arg)
  982.     (hankaku-region start (point))))
  983.  
  984. (defvar *hankaku-alist*
  985.   '(( 161 . ?\  ) 
  986.     ( 170 . ?\! )
  987.     ( 201 . ?\" )
  988.     ( 244 . ?\# )
  989.     ( 240 . ?\$ )
  990.     ( 243 . ?\% )
  991.     ( 245 . ?\& )
  992.     ( 199 . ?\' )
  993.     ( 202 . ?\( )
  994.     ( 203 . ?\) )
  995.     ( 246 . ?\* )
  996.     ( 220 . ?\+ )
  997.     ( 164 . ?\, )
  998.     ( 221 . ?\- )
  999.     ( 165 . ?\. )
  1000.     ( 191 . ?\/ )
  1001.     ( 167 . ?\: )
  1002.     ( 168 . ?\; )
  1003.     ( 227 . ?\< )
  1004.     ( 225 . ?\= )
  1005.     ( 228 . ?\> )
  1006.     ( 169 . ?\? )
  1007.     ( 247 . ?\@ )
  1008.     ( 206 . ?\[ )
  1009.     ( 239 . ?\\ )
  1010.     ( 207 . ?\] )
  1011.     ( 176 . ?^ )
  1012.     ( 178 . ?\_ )
  1013.     ( 208 . ?\{ )
  1014.     ( 195 . ?\| )
  1015.     ( 209 . ?\} )
  1016.     ( 177 . ?\~ )
  1017.     ( 198 . ?` )            ; 92.6.26 by M.Shikida
  1018.     ))
  1019.  
  1020. ;;;
  1021. ;;; $BA43QJQ49(B
  1022. ;;;
  1023.  
  1024. (defun zenkaku-region (start end)
  1025.   (interactive "r")
  1026.   (save-restriction
  1027.     (narrow-to-region start end)
  1028.     (goto-char (point-min))
  1029.     (while (re-search-forward "[ -~]" (point-max) (point-max))
  1030.       (let ((ch (char-before (point))))
  1031.     (if (and (<= ?  ch) (<= ch ?~))
  1032.         (progn
  1033.           (delete-char -1)
  1034.           (let ((zen (cdr (assq ch *zenkaku-alist*))))
  1035.         (if zen (insert zen)
  1036.           (insert (make-char (find-charset 'japanese-jisx0208) 38
  1037.                      (char-to-int ch)))))))))))
  1038.  
  1039. (defun zenkaku-paragraph ()
  1040.   "zenkaku  paragraph at or after point."
  1041.   (interactive )
  1042.   (save-excursion
  1043.     (forward-paragraph)
  1044.     (let ((end (point)))
  1045.       (backward-paragraph)
  1046.       (zenkaku-region (point) end ))))
  1047.  
  1048. (defun zenkaku-sentence ()
  1049.   "zenkaku  sentence at or after point."
  1050.   (interactive )
  1051.   (save-excursion
  1052.     (forward-sentence)
  1053.     (let ((end (point)))
  1054.       (backward-sentence)
  1055.       (zenkaku-region (point) end ))))
  1056.  
  1057. (defun zenkaku-word (arg)
  1058.   (interactive "p")
  1059.   (let ((start (point)))
  1060.     (forward-word arg)
  1061.     (zenkaku-region start (point))))
  1062.  
  1063. (defvar *zenkaku-alist*
  1064.   '((?  . "$B!!(B") 
  1065.     (?! . "$B!*(B")
  1066.     (?\" . "$B!I(B")
  1067.     (?# . "$B!t(B")
  1068.     (?$ . "$B!p(B")
  1069.     (?% . "$B!s(B")
  1070.     (?& . "$B!u(B")
  1071.     (?' . "$B!G(B")
  1072.     (?( . "$B!J(B")
  1073.     (?) . "$B!K(B")
  1074.     (?* . "$B!v(B")
  1075.     (?+ . "$B!\(B")
  1076.     (?, . "$B!$(B")
  1077.     (?- . "$B!](B")
  1078.     (?. . "$B!%(B")
  1079.     (?/ . "$B!?(B")
  1080.     (?: . "$B!'(B")
  1081.     (?\; . "$B!((B")
  1082.     (?< . "$B!c(B")
  1083.     (?= . "$B!a(B")
  1084.     (?> . "$B!d(B")
  1085.     (?? . "$B!)(B")
  1086.     (?@ . "$B!w(B")
  1087.     (?[ . "$B!N(B")
  1088.     (?\\ . "$B!o(B")
  1089.     (?] . "$B!O(B")
  1090.     (?^ . "$B!0(B")
  1091.     (?_ . "$B!2(B")
  1092.     (?{ . "$B!P(B")
  1093.     (?| . "$B!C(B")
  1094.     (?} . "$B!Q(B")
  1095.     (?~ . "$B!1(B")
  1096.     (?` . "$B!F(B")))            ; 92.6.26 by M.Shikida
  1097.  
  1098. ;;;
  1099. ;;; $B%m!<%^;z$+$JJQ49(B
  1100. ;;;
  1101.  
  1102. (defun roma-kana-region (start end )
  1103.   (interactive "r")
  1104.   (its:translate-region start end nil (its:get-mode-map "roma-kana")))
  1105.  
  1106. (defun roma-kana-paragraph ()
  1107.   "roma-kana  paragraph at or after point."
  1108.   (interactive )
  1109.   (save-excursion
  1110.     (forward-paragraph)
  1111.     (let ((end (point)))
  1112.       (backward-paragraph)
  1113.       (roma-kana-region (point) end ))))
  1114.  
  1115. (defun roma-kana-sentence ()
  1116.   "roma-kana  sentence at or after point."
  1117.   (interactive )
  1118.   (save-excursion
  1119.     (forward-sentence)
  1120.     (let ((end (point)))
  1121.       (backward-sentence)
  1122.       (roma-kana-region (point) end ))))
  1123.  
  1124. (defun roma-kana-word ()
  1125.   "roma-kana word at or after point."
  1126.   (interactive)
  1127.   (save-excursion
  1128.     (re-search-backward "\\b\\w" nil t)
  1129.     (let ((start (point)))
  1130.       (re-search-forward "\\w\\b" nil t)
  1131.       (roma-kana-region start (point)))))
  1132.  
  1133. ;;;
  1134. ;;; $B%m!<%^;z4A;zJQ49(B
  1135. ;;;
  1136.  
  1137. (defun roma-kanji-region (start end)
  1138.   (interactive "r")
  1139.   (roma-kana-region start end)
  1140.   (save-restriction
  1141.     (narrow-to-region start (point))
  1142.     (goto-char (point-min))
  1143.     (replace-regexp "\\($B!!(B\\| \\)" "")
  1144.     (goto-char (point-max)))
  1145.   (henkan-region-internal start (point)))
  1146.  
  1147. (defun roma-kanji-paragraph ()
  1148.   "roma-kanji  paragraph at or after point."
  1149.   (interactive )
  1150.   (save-excursion
  1151.     (forward-paragraph)
  1152.     (let ((end (point)))
  1153.       (backward-paragraph)
  1154.       (roma-kanji-region (point) end ))))
  1155.  
  1156. (defun roma-kanji-sentence ()
  1157.   "roma-kanji  sentence at or after point."
  1158.   (interactive )
  1159.   (save-excursion
  1160.     (forward-sentence)
  1161.     (let ((end (point)))
  1162.       (backward-sentence)
  1163.       (roma-kanji-region (point) end ))))
  1164.  
  1165. (defun roma-kanji-word ()
  1166.   "roma-kanji word at or after point."
  1167.   (interactive)
  1168.   (save-excursion
  1169.     (re-search-backward "\\b\\w" nil t)
  1170.     (let ((start (point)))
  1171.       (re-search-forward "\\w\\b" nil t)
  1172.       (roma-kanji-region start (point)))))
  1173.  
  1174.  
  1175. ;;;----------------------------------------------------------------------
  1176. ;;;
  1177. ;;; $B!V$?$^$4!WF~NOJ8;zJQ497O(B ITS
  1178. ;;; 
  1179. ;;;----------------------------------------------------------------------
  1180.  
  1181. (defun egg:member (elt list)
  1182.   (while (not (or (null list) (equal elt (car list))))
  1183.     (setq list (cdr list)))
  1184.   list)
  1185.  
  1186. ;;;
  1187. ;;; Mode name --> map
  1188. ;;;
  1189. ;;; ITS mode name: string
  1190.  
  1191. (defvar its:*mode-alist* nil)
  1192. (defvar its:*internal-mode-alist* nil)
  1193.  
  1194. (defun its:get-mode-map (name)
  1195.   (or (cdr (assoc name its:*mode-alist*))
  1196.       (cdr (assoc name its:*internal-mode-alist*))))
  1197.  
  1198. (defun its:set-mode-map (name map &optional internalp)
  1199.   (let ((place (assoc name 
  1200.               (if internalp its:*internal-mode-alist*
  1201.             its:*mode-alist*))))
  1202.     (if place (let ((mapplace (cdr place)))
  1203.         (setcar mapplace (car map))
  1204.         (setcdr mapplace (cdr map)))
  1205.       (progn (setq place (cons name map))
  1206.          (if internalp
  1207.          (setq its:*internal-mode-alist*
  1208.                (append its:*internal-mode-alist* (list place)))
  1209.            (setq its:*mode-alist* 
  1210.              (append its:*mode-alist* (list place))))))))
  1211.  
  1212. ;;;
  1213. ;;; ITS mode indicators
  1214. ;;; Mode name --> indicator
  1215. ;;;
  1216.  
  1217. (defun its:get-mode-indicator (name)
  1218.   (let ((map (its:get-mode-map name)))
  1219.     (if map (map-indicator map)
  1220.       name)))
  1221.  
  1222. (defun its:set-mode-indicator (name indicator)
  1223.   (let ((map (its:get-mode-map name)))
  1224.     (if map
  1225.     (map-set-indicator map indicator)
  1226.       (its-define-mode name indicator))))
  1227.  
  1228. ;;;
  1229. ;;; ITS mode declaration
  1230. ;;;
  1231.  
  1232. (defvar its:*processing-map* nil)
  1233.  
  1234. (defun its-define-mode (name &optional indicator reset supers internalp) 
  1235.   "its-mode NAME $B$rDj5AA*Br$9$k!%B>$N(B its-mode $B$,A*Br$5$l$k$^$G$O(B 
  1236. its-defrule $B$J$I$O(B NAME $B$KBP$7$F5,B'$rDI2C$9$k!%(BINDICATOR $B$,(B non-nil 
  1237. $B$N;~$K$O(B its-mode NAME $B$rA*Br$9$k$H(B mode-line $B$KI=<($5$l$k!%(BRESET $B$,(B 
  1238. non-nil $B$N;~$K$O(B its-mode $B$NDj5A$,6u$K$J$k!%(BSUPERS $B$O>e0L$N(B its-mode 
  1239. $BL>$r%j%9%H$G;XDj$9$k!%(BINTERNALP $B$O(B mode name $B$rFbItL>$H$9$k!%(B
  1240. its-defrule, its-defrule-conditional, defule-select-mode-temporally $B$r(B
  1241. $B;2>H(B"
  1242.  
  1243.   (if (null(its:get-mode-map name))
  1244.       (progn 
  1245.     (setq its:*processing-map* 
  1246.           (make-map nil (or indicator name) nil (mapcar 'its:get-mode-map supers)))
  1247.     (its:set-mode-map name its:*processing-map* internalp)
  1248.     )
  1249.     (progn (setq its:*processing-map* (its:get-mode-map name))
  1250.        (if indicator
  1251.            (map-set-indicator its:*processing-map* indicator))
  1252.        (if reset
  1253.            (progn
  1254.          (map-set-state its:*processing-map* nil)
  1255.          (map-set-alist its:*processing-map* nil)
  1256.          ))
  1257.        (if supers
  1258.            (progn
  1259.          (map-set-supers its:*processing-map* (mapcar 'its:get-mode-map supers))))))
  1260.   nil)
  1261.  
  1262. ;;;
  1263. ;;; defrule related utilities
  1264. ;;;
  1265.  
  1266. (put 'for-each 'lisp-indent-hook 1)
  1267.  
  1268. (defmacro for-each (vars &rest body)
  1269.   "(for-each ((VAR1 LIST1) ... (VARn LISTn)) . BODY) $B$OJQ?t(B VAR1 $B$NCM(B
  1270. $B$r%j%9%H(B LIST1 $B$NMWAG$KB+G{$7!$!%!%!%JQ?t(B VARn $B$NCM$r%j%9%H(B LISTn $B$NMW(B
  1271. $BAG$KB+G{$7$F(B BODY $B$r<B9T$9$k!%(B"
  1272.  
  1273.   (for-each* vars (cons 'progn body)))
  1274.  
  1275. (defun for-each* (vars body)
  1276.   (cond((null vars) body)
  1277.        (t (let((tvar (make-symbol "temp"))
  1278.            (var  (car (car vars)))
  1279.            (val  (car (cdr (car vars)))))
  1280.         (list 'let (list (list tvar val)
  1281.                  var)
  1282.           (list 'while tvar
  1283.             (list 'setq var (list 'car tvar))
  1284.             (for-each* (cdr vars) body)
  1285.             (list 'setq tvar (list 'cdr tvar))))))))
  1286.                  
  1287. (put 'dolist 'lisp-indent-hook 1)
  1288.  
  1289. (defmacro dolist (pair &rest body)
  1290.   "(dolist (VAR LISTFORM) . BODY) $B$O(BVAR $B$K=g<!(B LISTFORM $B$NMWAG$rB+G{$7(B
  1291. $B$F(B BODY $B$r<B9T$9$k(B"
  1292.  
  1293.   (for-each* (list pair) (cons 'progn body)))
  1294.  
  1295. ;;;
  1296. ;;; defrule
  1297. ;;; 
  1298.  
  1299. (defun its:make-standard-action (output next)
  1300.   "OUTPUT $B$H(B NEXT $B$+$i$J$k(B standard-action $B$r:n$k!%(B"
  1301.  
  1302.   (if (and (stringp output) (string-equal output ""))
  1303.       (setq output nil))
  1304.   (if (and (stringp next)   (string-equal next   ""))
  1305.       (setq next nil))
  1306.   (cond((null output)
  1307.     (cond ((null next) nil)
  1308.           (t (list nil next))))
  1309.        ((consp output)
  1310.     ;;; alternative output
  1311.     (list (cons 0 output) next))
  1312.        ((null next) output)
  1313.        (t
  1314.     (list output next))))
  1315.  
  1316. (defun its:standard-actionp (action)
  1317.   "ACITION $B$,(B standard-action $B$G$"$k$+$I$&$+$rH=Dj$9$k!%(B"
  1318.   (or (stringp action)
  1319.       (and (consp action)
  1320.        (or (stringp (car action))
  1321.            (and (consp (car action))
  1322.             (characterp (car (car action))))
  1323.            (null (car action)))
  1324.        (or (null (car (cdr action)))
  1325.            (stringp (car (cdr action)))))))
  1326.  
  1327. (defvar its:make-terminal-state 'its:default-make-terminal-state 
  1328.   "$B=*C<$N>uBV$G$NI=<($r:n@.$9$k4X?t$r;XDj$9$k(B. $B4X?t$O(B map input
  1329. action state $B$r0z?t$H$7$F8F$P$l!$>uBVI=<($NJ8;zNs$rJV$9!%(B")
  1330.  
  1331. (defun its:default-make-terminal-state (map input action state)
  1332.   (cond(state state)
  1333.        (t input)))
  1334.  
  1335. (defun its:make-terminal-state-hangul (map input action state)
  1336.   (cond((its:standard-actionp action) (action-output action))
  1337.        (t nil)))
  1338.  
  1339. (defvar its:make-non-terminal-state 'its:default-make-standard-non-terminal-state
  1340.   "$BHs=*C<$N>uBV$G$NI=<($r:n@.$9$k4X?t$r;XDj$9$k!%4X?t$O(B map input $B$r(B
  1341. $B0z?t$H$7$F8F$P$l!$>uBVI=<($NJ8;zNs$rJV$9(B" )
  1342.  
  1343. (defun its:default-make-standard-non-terminal-state (map input)
  1344.   " ****"
  1345.   (concat
  1346.    (map-state-string map)
  1347.    (char-to-string (aref input (1- (length input))))))
  1348.  
  1349. (defun its-defrule (input output &optional next state map) 
  1350.  
  1351.   "INPUT $B$,F~NO$5$l$k$H(B OUTPUT $B$KJQ49$9$k!%(BNEXT $B$,(B nil $B$G$J$$$H$-$OJQ(B
  1352. $B49$7$?8e$K(B NEXT $B$,F~NO$5$l$?$h$&$KJQ49$rB3$1$k!%(BINPUT$B$,F~NO$5$l$?;~E@(B
  1353. $B$GJQ49$,3NDj$7$F$$$J$$;~$O(B STATE $B$r%U%'%s%9>e$KI=<($9$k!%JQ49$,3NDj$7(B
  1354. $B$F$$$J$$;~$KI=<($9$kJ8;zNs$OJQ?t(B its:make-terminal-state $B$*$h$S(B $BJQ?t(B 
  1355. its:make-non-terminal-state $B$K;X<($5$l$?4X?t$K$h$C$F@8@.$5$l$k!%JQ495,(B
  1356. $BB'$O(B MAP $B$G;XDj$5$l$?JQ49I=$KEPO?$5$l$k!%(BMAP $B$,(B nil $B$N>l9g$O$b$C$H$b:G(B
  1357. $B6a$K(B its-define-mode $B$5$l$?JQ49I=$KEPO?$5$l$k!%$J$*(B OUTPUT $B$,(B nil $B$N>l(B
  1358. $B9g$O(B INPUT $B$KBP$9$kJQ495,B'$,:o=|$5$l$k!%(B"
  1359.  
  1360.   (its-defrule* input
  1361.     (its:make-standard-action output next) state 
  1362.     (if (stringp map) map
  1363.       its:*processing-map*)))
  1364.  
  1365. (defmacro its-defrule-conditional (input &rest conds)
  1366.   "(its-defrule-conditional INPUT ((COND1 OUTPUT1) ... (CONDn OUTPUTn)))$B$O(B 
  1367. INPUT $B$,F~NO$5$l$?;~$K>r7o(B CONDi $B$r=g<!D4$Y!$@.N)$7$?;~$K$O(B OUTPUTi $B$r(B
  1368. $B=PNO$9$k!%(B"
  1369.   (list 'its-defrule* input (list 'quote (cons 'cond conds))))
  1370.  
  1371. (defmacro its-defrule-conditional* (input state map &rest conds)
  1372.   "(its-defrule-conditional INPUT STATE MAP ((COND1 OUTPUT1) ... (CONDn
  1373. OUTPUTn)))$B$O(B INPUT $B$,F~NO$5$l$?;~$K>uBV(B STATE $B$rI=<($7!$>r7o(B CONDi $B$r(B
  1374. $B=g<!D4$Y!$@.N)$7$?;~$K$O(B OUTPUTi $B$r=PNO$9$k!%(B"
  1375.   (list 'its-defrule* input (list 'quote (cons 'cond conds)) state map))
  1376.  
  1377. (defun its-defrule-select-mode-temporally (input name)
  1378.   "INPUT $B$,F~NO$5$l$k$H(B temporally-mode $B$H$7$F(B NAME $B$,A*Br$5$l$k!%(B"
  1379.  
  1380.   (its-defrule* input (list 'quote (list 'its:select-mode-temporally name))))
  1381.  
  1382. (defun its-defrule* (input action &optional state map)
  1383.   (its:resize (length input))
  1384.   (setq map (cond((stringp map) (its:get-mode-map map))
  1385.          ((null map) its:*processing-map*)
  1386.          (t map)))
  1387.   (its-defrule** 0 input action state map)
  1388.   map)
  1389.  
  1390. (defvar its:*defrule-verbose* t "nil$B$N>l9g(B, its-defrule $B$N7Y9p$rM^@)$9$k(B")
  1391.  
  1392. (defun its-defrule** (i input action state map)
  1393.   (cond((= (length input) i)        ;93.6.4 by T.Shingu
  1394.     (map-set-state
  1395.      map 
  1396.      (coerce-internal-string 
  1397.       (funcall its:make-terminal-state map input action state)))
  1398.     (if (and its:*defrule-verbose* (map-action map))
  1399.         (if action
  1400.         (notify "(its-defrule \"%s\" \"%s\" ) $B$r:FDj5A$7$^$7$?!%(B"
  1401.             input action)
  1402.           (notify "(its-defrule \"%s\" \"%s\" )$B$r:o=|$7$^$7$?!%(B"
  1403.               input (map-action map))))
  1404.     (if (and (null action) (map-terminalp map)) nil
  1405.       (progn (map-set-action map action)
  1406.          map)))
  1407.        (t
  1408.     (let((newmap
  1409.           (or (get-next-map-locally map (sref input i))
  1410.           (make-map (funcall its:make-non-terminal-state
  1411.                      map
  1412.                      (substring input 0 (+ i (char-bytes (sref input i)))))))))
  1413.       (set-next-map map (sref input i) 
  1414.             (its-defrule** (+ i (char-bytes (sref input i))) input action state newmap)))
  1415.     (if (and (null (map-action map))
  1416.          (map-terminalp map))
  1417.         nil
  1418.       map))))
  1419.  
  1420. ;;;
  1421. ;;; map: 
  1422. ;;;
  1423. ;;; <map-alist> ::= ( ( <char> . <map> ) ... )
  1424. ;;; <topmap> ::= ( nil <indicator> <map-alist>  <supers> )
  1425. ;;; <supers> ::= ( <topmap> .... )
  1426. ;;; <map>    ::= ( <state> <action>    <map-alist> )
  1427. ;;; <action> ::= <output> | ( <output> <next> ) ....
  1428.  
  1429. (defun make-map (&optional state action alist supers)
  1430.   (list state action alist supers))
  1431.  
  1432. (defun map-topmap-p (map)
  1433.   (null (map-state map)))
  1434.  
  1435. (defun map-supers (map)
  1436.   (nth 3 map))
  1437.  
  1438. (defun map-set-supers (map val)
  1439.   (setcar (nthcdr 3 map) val))
  1440.  
  1441. (defun map-terminalp (map)
  1442.   (null (map-alist map)))
  1443.  
  1444. (defun map-state (map)
  1445.   (nth 0 map))
  1446.  
  1447. (defun map-state-string (map)
  1448.   (coerce-string (map-state map)))
  1449.  
  1450. (defun map-set-state (map val)
  1451.   (setcar (nthcdr 0 map) val))
  1452.  
  1453. (defun map-indicator (map)
  1454.   (map-action map))
  1455. (defun map-set-indicator (map indicator)
  1456.   (map-set-action map indicator))
  1457.  
  1458. (defun map-action (map)
  1459.   (nth 1 map))
  1460. (defun map-set-action (map val)
  1461.   (setcar (nthcdr 1 map) val))
  1462.  
  1463. (defun map-alist (map)
  1464.   (nth 2 map))
  1465.  
  1466. (defun map-set-alist (map alist)
  1467.   (setcar (nthcdr 2 map) alist))
  1468.  
  1469. (defun get-action (map)
  1470.   (if (null map) nil
  1471.     (let ((action (map-action map)))
  1472.       (cond((its:standard-actionp action)
  1473.         action)
  1474.        ((symbolp action) (condition-case nil
  1475.                  (funcall action)
  1476.                    (error nil)))
  1477.        (t (condition-case nil
  1478.           (eval action)
  1479.         (error nil)))))))
  1480.  
  1481. (defun action-output (action)
  1482.   (cond((stringp action) action)
  1483.        (t (car action))))
  1484.  
  1485. (defun action-next (action)
  1486.   (cond((stringp action) nil)
  1487.        (t (car (cdr action)))))
  1488.  
  1489. (defun get-next-map (map ch)
  1490.   (or (cdr (assq ch (map-alist map)))
  1491.       (if (map-topmap-p map)
  1492.       (let ((supers (map-supers map))
  1493.         (result nil))
  1494.         (while supers
  1495.           (setq result (get-next-map (car supers) ch))
  1496.           (if result
  1497.           (setq supers nil)
  1498.         (setq supers (cdr supers))))
  1499.         result))))
  1500.  
  1501. (defun get-next-map-locally (map ch)
  1502.   (cdr (assq ch (map-alist map))))
  1503.   
  1504. (defun set-next-map (map ch val)
  1505.   (let ((place (assq ch (map-alist map))))
  1506.     (if place
  1507.     (if val
  1508.         (setcdr place val)
  1509.       (map-set-alist map (delq place (map-alist map))))
  1510.       (if val
  1511.       (map-set-alist map (cons (cons ch val)
  1512.                    (map-alist map)))
  1513.     val))))
  1514.  
  1515. (defun its:simple-actionp (action)
  1516.   (stringp action))
  1517.  
  1518. (defun collect-simple-action (map)
  1519.   (if (map-terminalp map)
  1520.       (if (its:simple-actionp (map-action map))
  1521.       (list (map-action map))
  1522.     nil)
  1523.     (let ((alist (map-alist map))
  1524.       (result nil))
  1525.       (while alist
  1526.     (setq result 
  1527.           ;;; 92.9.19 by Y. Kawabe
  1528.           (append (collect-simple-action (cdr (car alist)))
  1529.               result))
  1530.     (setq alist (cdr alist)))
  1531.       result)))
  1532.  
  1533. ;;;----------------------------------------------------------------------
  1534. ;;;
  1535. ;;; Runtime translators
  1536. ;;;
  1537. ;;;----------------------------------------------------------------------
  1538.       
  1539. (defun its:simulate-input (i j  input map)
  1540.   (while (<= i j)
  1541.     (setq map (get-next-map map (sref input i))) ;92.12.26 by S.Tomura
  1542.     (setq i (+ i (char-bytes (sref input i)))))    ;92.12.26 by S.Tomura
  1543.   map)
  1544.  
  1545. ;;; meta-flag $B$,(B on $B$N;~$K$O!"F~NO%3!<%I$K(B \200 $B$r(B or $B$7$?$b$N$,F~NO$5(B
  1546. ;;; $B$l$k!#$3$NItJ,$N;XE&$OEl9)Bg$NCf@n(B $B5.G7$5$s$K$h$k!#(B
  1547. ;;; pointted by nakagawa@titisa.is.titech.ac.jp Dec-11-89
  1548. ;;;
  1549. ;;; emacs $B$G$O(B $BJ8;z%3!<%I$O(B 0-127 $B$G07$&!#(B
  1550. ;;;
  1551.  
  1552. (defvar its:*buff-s* (make-marker))
  1553. (defvar its:*buff-e* (make-marker))
  1554. (set-marker-insertion-type its:*buff-e* t)
  1555.  
  1556. ;;;    STATE     unread
  1557. ;;; |<-s   p->|<-    e ->|
  1558. ;;; s  : ch0  state0  map0
  1559. ;;;  +1: ch1  state1  map1
  1560. ;;; ....
  1561. ;;; (point):
  1562.  
  1563. ;;; longest matching region : [s m]
  1564. ;;; suspending region:        [m point]
  1565. ;;; unread region          :  [point e]
  1566.  
  1567.  
  1568. (defvar its:*maxlevel* 10)
  1569. (defvar its:*maps*   (make-vector its:*maxlevel* nil))
  1570. (defvar its:*actions* (make-vector its:*maxlevel* nil))
  1571. (defvar its:*inputs* (make-vector its:*maxlevel* 0))
  1572. (defvar its:*level* 0)
  1573.  
  1574. (defun its:resize (size)
  1575.   (if (<= its:*maxlevel* size)
  1576.       (setq its:*maxlevel* size
  1577.         its:*maps*    (make-vector size nil)
  1578.         its:*actions* (make-vector size nil)
  1579.         its:*inputs*  (make-vector size 0))))
  1580.  
  1581. (defun its:reset-maps (&optional init)
  1582.   (setq its:*level* 0)
  1583.   (if init
  1584.       (aset its:*maps* its:*level* init)))
  1585.  
  1586. (defun its:current-map () (aref its:*maps* its:*level*))
  1587. (defun its:previous-map () (aref its:*maps* (max 0 (1- its:*level*))))
  1588.  
  1589. (defun its:level () its:*level*)
  1590.  
  1591. (defun its:enter-newlevel (map ch output)
  1592.   (setq its:*level* (1+ its:*level*))
  1593.   (aset its:*maps* its:*level* map)
  1594.   (aset its:*inputs* its:*level* ch)
  1595.   (aset its:*actions* its:*level* output))
  1596.  
  1597. (defvar its:*char-from-buff* nil)
  1598. (defvar its:*interactive* t)
  1599.  
  1600. (defun its:reset-input ()
  1601.   (setq its:*char-from-buff* nil))
  1602.  
  1603. (defun its:flush-input-before-point (from)
  1604.   (save-excursion
  1605.     (while (<= from its:*level*)
  1606.       (its:insert-char (aref its:*inputs* from))
  1607.       (setq from (1+ from)))))
  1608.  
  1609. (defun its:peek-char ()
  1610.   (if (= (point) its:*buff-e*)
  1611.       (if its:*interactive*
  1612.       (let ((ch (egg-read-event)))
  1613.         (if ch
  1614.         (progn
  1615.           (setq unread-command-events (list (character-to-event ch)))
  1616.           ch)
  1617.           nil))
  1618.     nil)
  1619.     (char-after (point))))
  1620.  
  1621. (defun its:read-char ()
  1622.   (if (= (point) its:*buff-e*)
  1623.       (progn 
  1624.     (setq its:*char-from-buff* nil)
  1625.     (if its:*interactive*
  1626.         (egg-read-event)
  1627.       nil))
  1628.     (let ((ch (char-after (point))))
  1629.       (setq its:*char-from-buff* t)
  1630.       (delete-char 1)
  1631.       ch)))
  1632.  
  1633. (defun its:push-char (ch)
  1634.   (if its:*char-from-buff*
  1635.       (save-excursion
  1636.     (its:insert-char ch))
  1637.     (if ch (setq unread-command-events (list (character-to-event ch))))))
  1638.  
  1639. (defun its:insert-char (ch)
  1640.   (insert ch))
  1641.  
  1642. (defun its:ordinal-charp (ch)
  1643.   (and (characterp ch) (<= ch 127)
  1644.        (eq (lookup-key fence-mode-map (char-to-string ch)) 'fence-self-insert-command)))
  1645.  
  1646. (defun its:delete-charp (ch)
  1647.   (and (characterp ch) (<= ch 127)
  1648.        (eq (lookup-key fence-mode-map (char-to-string ch)) 'fence-backward-delete-char)))
  1649.     
  1650. (defvar egg:fence-buffer nil "Buffer fence is active in")
  1651.  
  1652. (defun fence-self-insert-command ()
  1653.   (interactive)
  1654.   (if (not (eq (current-buffer) egg:fence-buffer))
  1655.       nil    ;; #### This is to bandaid a deep event-handling bug
  1656.     (let ((ch (event-to-character last-command-event)))
  1657.       (cond((or (not egg:*input-mode*)
  1658.         (null (get-next-map its:*current-map* ch)))
  1659.         (insert ch))
  1660.        (t
  1661.         (insert ch)
  1662.         (its:translate-region (1- (point)) (point) t))))))
  1663.  
  1664. ;;;
  1665. ;;; its: completing-read system
  1666. ;;;
  1667.  
  1668. (defun its:all-completions (string alist &optional pred)
  1669.   "A variation of all-completions.\n\
  1670. Arguments are STRING, ALIST and optional PRED. ALIST must be no obarray."
  1671.   (let ((tail alist) (allmatches nil))
  1672.     (while tail
  1673.       (let* ((elt (car tail))
  1674.          (eltstring (car elt)))
  1675.     (setq tail (cdr tail))
  1676.     (if (and (stringp eltstring)
  1677.          (<= (length string) (length eltstring))
  1678.          ;;;(not (= (aref eltstring 0) ? ))
  1679.          (string-equal string (substring eltstring 0 (length string))))
  1680.         (if (or (and pred
  1681.              (if (if (eq pred 'commandp)
  1682.                  (commandp elt)
  1683.                    (funcall pred elt))))
  1684.             (null pred))
  1685.         (setq allmatches (cons elt allmatches))))))
  1686.     (nreverse allmatches)))
  1687.  
  1688. (defun its:temp-echo-area-contents (message)
  1689.   (let ((inhibit-quit inhibit-quit)
  1690.     (point-max (point-max)))
  1691.     (goto-char point-max)
  1692.     (insert message)
  1693.     (goto-char point-max)
  1694.     (setq inhibit-quit t)
  1695.     (sit-for 2 nil)
  1696.     ;;; 92.9.19 by Y. Kawabe, 92.10.30 by T.Saneto
  1697.     (delete-region (point) (point-max))
  1698.     (if quit-flag
  1699.     (progn
  1700.       (setq quit-flag nil)
  1701.       (setq unread-command-events (list (character-to-event ?\^G)))))))
  1702.  
  1703. (defun car-string-lessp (item1 item2)
  1704.   (string-lessp (car item1) (car item2)))
  1705.  
  1706. (defun its:minibuffer-completion-help ()
  1707.     "Display a list of possible completions of the current minibuffer contents."
  1708.     (interactive)
  1709.     (let ((completions))
  1710.       (message "Making completion list...")
  1711.       (setq completions (its:all-completions (buffer-string)
  1712.                      minibuffer-completion-table
  1713.                      minibuffer-completion-predicate))
  1714.       (if (null completions)
  1715.       (progn
  1716.         ;;; 92.9.19 by Y. Kawabe
  1717.         (beep)
  1718.         (its:temp-echo-area-contents " [No completions]"))
  1719.     (with-output-to-temp-buffer "*Completions*"
  1720.       (display-completion-list
  1721.        (sort completions 'car-string-lessp))))
  1722.       nil))
  1723.  
  1724. (defconst its:minibuffer-local-completion-map 
  1725.   (copy-keymap minibuffer-local-completion-map))
  1726. (define-key its:minibuffer-local-completion-map "?" 'its:minibuffer-completion-help)
  1727. (define-key its:minibuffer-local-completion-map " " 'its:minibuffer-completion-help)
  1728.  
  1729. (defconst its:minibuffer-local-must-match-map
  1730.   (copy-keymap minibuffer-local-must-match-map))
  1731. (define-key its:minibuffer-local-must-match-map "?" 'its:minibuffer-completion-help)
  1732. (define-key its:minibuffer-local-must-match-map " " 'its:minibuffer-completion-help)
  1733.  
  1734. (fset 'si:all-completions (symbol-function 'all-completions))
  1735. (fset 'si:minibuffer-completion-help (symbol-function 'minibuffer-completion-help))
  1736.  
  1737. (defun its:completing-read (prompt table &optional predicate require-match initial-input)
  1738.   "See completing-read"
  1739.   (let ((minibuffer-local-completion-map its:minibuffer-local-completion-map)
  1740.     (minibuffer-local-must-match-map its:minibuffer-local-must-match-map)
  1741.     (completion-auto-help nil))
  1742.     (completing-read prompt table predicate t initial-input)))
  1743.  
  1744. (defvar its:*completing-input-menu* '(menu "Which?" nil)) ;92.10.26 by T.Saneto
  1745.  
  1746. (defun its:completing-input (map)
  1747.   ;;; 
  1748.   (let ((action (get-action map)))
  1749.     (cond((and (null action)
  1750.            (= (length (map-alist map)) 1))
  1751.       (its:completing-input (cdr (nth 0 (map-alist map)))))
  1752.      (t
  1753.       (setcar (nthcdr 2 its:*completing-input-menu*)
  1754.           (map-alist map))
  1755.       (let ((values
  1756.          (menu:select-from-menu its:*completing-input-menu*
  1757.                     0 t)))
  1758.         (cond((consp values)
  1759.           ;;; get input char from menu
  1760.           )
  1761.          (t
  1762.           (its:completing-input map))))))))
  1763.  
  1764. (defvar its:*make-menu-from-map-result* nil)
  1765.  
  1766. (defun its:make-menu-from-map (map)
  1767.   (let ((its:*make-menu-from-map-result* nil))
  1768.     (its:make-menu-from-map* map "")
  1769.     (list 'menu "Which?"  (reverse its:*make-menu-from-map-result*) )))
  1770.  
  1771. (defun its:make-menu-from-map* (map string)
  1772.   (let ((action (get-action map)))
  1773.     (if action
  1774.     (setq its:*make-menu-from-map-result*
  1775.           (cons (format "%s[%s]" string (action-output action))
  1776.             its:*make-menu-from-map-result*)))
  1777.     (let ((alist (map-alist map)))
  1778.       (while alist
  1779.     (its:make-menu-from-map* 
  1780.      (cdr (car alist))
  1781.      (concat string (char-to-string (car (car alist)))))
  1782.     (setq alist (cdr alist))))))
  1783.  
  1784. (defvar its:*make-alist-from-map-result* nil)
  1785.  
  1786. (defun its:make-alist-from-map (map &optional string)
  1787.   (let ((its:*make-alist-from-map-result* nil))
  1788.     (its:make-alist-from-map* map (or string ""))
  1789.     (reverse its:*make-alist-from-map-result*)))
  1790.  
  1791. (defun its:make-alist-from-map* (map string)
  1792.   (let ((action (get-action map)))
  1793.     (if action
  1794.     (setq its:*make-alist-from-map-result*
  1795.           (cons (list string 
  1796.               (let ((action-output (action-output action)))
  1797.                 (cond((and (consp action-output)
  1798.                        (characterp (car action-output)))
  1799.                   (format "%s..."
  1800.                   (nth (car action-output) (cdr action-output))))
  1801.                  ((stringp action-output)
  1802.                   action-output)
  1803.                  (t
  1804.                   (format "%s" action-output)))))
  1805.             its:*make-alist-from-map-result*)))
  1806.     (let ((alist (map-alist map)))
  1807.       (while alist
  1808.     (its:make-alist-from-map* 
  1809.      (cdr (car alist))
  1810.      (concat string (char-to-string (car (car alist)))))
  1811.     (setq alist (cdr alist))))))
  1812.  
  1813. (defvar its:*select-alternative-output-menu* '(menu "Which?" nil))
  1814.  
  1815. (defun its:select-alternative-output (action-output)
  1816.   ;;;; action-output : (pos item1 item2 item3 ....)
  1817.   (let ((point (point))
  1818.     (output (cdr action-output))
  1819.     (ch 0))
  1820.     (while (not (eq ch ?\^L))
  1821.       (insert "<" (nth (car action-output)output) ">")
  1822.       (setq ch (egg-read-event))
  1823.       (cond ((eq ch ?\^N)
  1824.          (setcar action-output
  1825.              (mod (1+ (car action-output)) (length output))))
  1826.         ((eq ch ?\^P)
  1827.          (setcar action-output
  1828.              (if (= 0 (car action-output))
  1829.              (1- (length output))
  1830.                (1- (car action-output)))))
  1831.         ((eq ch ?\^M)
  1832.          (setcar (nthcdr 2 its:*select-alternative-output-menu* )
  1833.              output)
  1834.          (let ((values 
  1835.             (menu:select-from-menu its:*select-alternative-output-menu*
  1836.                        (car action-output)
  1837.                        t)))
  1838.            (cond((consp values)
  1839.              (setcar action-output (nth 1 values))
  1840.              (setq ch ?\^L)))))
  1841.         ((eq ch ?\^L)
  1842.          )
  1843.         (t
  1844.          (beep)
  1845.          ))
  1846.       (delete-region point (point)))
  1847.     (if its:*insert-output-string*
  1848.     (funcall its:*insert-output-string* (nth (car action-output) output))
  1849.       (insert (nth (car action-output) output)))))
  1850.       
  1851.     
  1852.  
  1853. ;;; translate until 
  1854. ;;;      interactive --> not ordinal-charp
  1855. ;;; or
  1856. ;;;      not interactive  --> end of input
  1857.  
  1858. (defvar its:*insert-output-string* nil)
  1859. (defvar its:*display-status-string* nil)
  1860.  
  1861. (defun its:translate-region (start end its:*interactive* &optional topmap)
  1862.   (set-marker its:*buff-s* start)
  1863.   (set-marker its:*buff-e* end)
  1864.   (its:reset-input)
  1865.   (goto-char its:*buff-s*)
  1866.   (let ((topmap (or topmap its:*current-map*))
  1867.     (map nil)
  1868.     (ch nil)
  1869.     (action nil)
  1870.     (newmap nil)
  1871.     (inhibit-quit t)
  1872.     (its-quit-flag nil)
  1873.     (echo-keystrokes 0))
  1874.     (setq map topmap)
  1875.     (its:reset-maps topmap)
  1876.     (while (not its-quit-flag)
  1877.       (setq ch (its:read-char))
  1878.       (setq newmap (get-next-map map ch))
  1879.       (setq action (get-action newmap))
  1880.  
  1881.       (cond
  1882.        ((and its:*interactive* (not its:*char-from-buff*) (characterp ch) (= ch ?\^@))
  1883.     (delete-region its:*buff-s* (point))
  1884.     (let ((i 1))
  1885.       (while (<= i its:*level*)
  1886.         (insert (aref its:*inputs* i))
  1887.         (setq i (1+ i))))
  1888.     (let ((inputs (its:completing-read "ITS:>" 
  1889.                        (its:make-alist-from-map topmap)
  1890.                        nil
  1891.                        t
  1892.                        (buffer-substring its:*buff-s* (point)))))
  1893.       (delete-region its:*buff-s* (point))
  1894.       (save-excursion (insert inputs))
  1895.       (its:reset-maps)
  1896.       (setq map topmap)
  1897.       ))
  1898.        ((or (null newmap)
  1899.         (and (map-terminalp newmap)
  1900.          (null action)))
  1901.  
  1902.     (cond((and its:*interactive* (its:delete-charp ch))
  1903.           (delete-region its:*buff-s* (point))
  1904.           (cond((= its:*level* 0)
  1905.             (setq its-quit-flag t))
  1906.            ((= its:*level* 1)
  1907.             (its:insert-char (aref its:*inputs* 1))
  1908.             (setq its-quit-flag t))
  1909.            (t
  1910.             (its:flush-input-before-point (1+ its:*level*))
  1911.             (setq its:*level* (1- its:*level*))
  1912.             (setq map (its:current-map))
  1913.             (if (and its:*interactive*
  1914.                  its:*display-status-string*)
  1915.             (funcall its:*display-status-string* (map-state map))
  1916.               (insert (map-state map)))
  1917.             )))
  1918.          (t
  1919.           (let ((output nil))
  1920.         (let ((i its:*level*) (newlevel (1+ its:*level*)))
  1921.           (aset its:*inputs* newlevel ch)
  1922.           (while (and (< 0 i) (null output))
  1923.             (if (and (aref its:*actions* i)
  1924.                  (its:simulate-input (1+ i) newlevel its:*inputs* topmap))
  1925.             (setq output i))
  1926.             (setq i (1- i)))
  1927.           (if (null output)
  1928.               (let ((i its:*level*))
  1929.             (while (and (< 0 i) (null output))
  1930.               (if (aref its:*actions* i)
  1931.                   (setq output i))
  1932.               (setq i (1- i)))))
  1933.  
  1934.           (cond(output 
  1935.             (delete-region its:*buff-s* (point))
  1936.             (cond((its:standard-actionp (aref its:*actions* output))
  1937.                   (let ((action-output (action-output (aref its:*actions* output))))
  1938.                 (if (and (not its:*interactive*)
  1939.                      (consp action-output))
  1940.                     (setq action-output (nth (car action-output) (cdr action-output))))
  1941.                 (cond((stringp action-output)
  1942.                       (if (and its:*interactive* 
  1943.                            its:*insert-output-string*)
  1944.                       (funcall its:*insert-output-string* action-output)
  1945.                     (insert action-output)))
  1946.                      ((consp action-output)
  1947.                       (its:select-alternative-output action-output)
  1948.                       )
  1949.                      (t
  1950.                       (beep) (beep)
  1951.                       )))
  1952.                   (set-marker its:*buff-s* (point))
  1953.                   (its:push-char ch)
  1954.                   (its:flush-input-before-point (1+ output))
  1955.                   (if (action-next (aref its:*actions* output))
  1956.                   (save-excursion
  1957.                     (insert (action-next (aref its:*actions* output)))))
  1958.                   )
  1959.                  ((symbolp (aref its:*actions* output))
  1960.                   (its:push-char ch)
  1961.                   (funcall (aref its:*actions* output))
  1962.                   (its:reset-maps its:*current-map*)
  1963.                   (setq topmap its:*current-map*)
  1964.                   (set-marker its:*buff-s* (point)))
  1965.                  (t 
  1966.                   (its:push-char ch)
  1967.                     ;92.10.26 by T.Saneto
  1968.                   (eval (aref its:*actions* output))
  1969.                   (its:reset-maps its:*current-map*)
  1970.                   (setq topmap its:*current-map*)
  1971.                   (set-marker its:*buff-s* (point))
  1972.                   ))
  1973.             )
  1974.                ((= 0 its:*level*)
  1975.             (cond ((or (its:ordinal-charp ch)
  1976.                    its:*char-from-buff*)
  1977.                    (its:insert-char ch))
  1978.                   (t (setq its-quit-flag t))))
  1979.  
  1980.                ((< 0 its:*level*)
  1981.             (delete-region its:*buff-s* (point))
  1982.             (its:insert-char (aref its:*inputs* 1))
  1983.             (set-marker its:*buff-s* (point))
  1984.             (its:push-char ch)
  1985.             (its:flush-input-before-point 2)))))
  1986.             
  1987.           (cond((null ch)
  1988.             (setq its-quit-flag t))
  1989.            ((not its-quit-flag)
  1990.             (its:reset-maps)
  1991.             (set-marker its:*buff-s* (point))
  1992.             (setq map topmap))))))
  1993.            
  1994.        ((map-terminalp newmap)
  1995.     (its:enter-newlevel (setq map newmap) ch action)
  1996.     (delete-region its:*buff-s* (point))
  1997.     (let ((output nil) (m nil) (i (1- its:*level*)))
  1998.       (while (and (< 0 i) (null output))
  1999.         (if (and (aref its:*actions* i)
  2000.              (setq m (its:simulate-input (1+ i) its:*level* its:*inputs* topmap))
  2001.              (not (map-terminalp m)))
  2002.         (setq output i))
  2003.         (setq i (1- i)))
  2004.  
  2005.       (cond((null output)
  2006.         (cond ((its:standard-actionp action)
  2007.                (let ((action-output (action-output action)))
  2008.              (if (and (not its:*interactive*)
  2009.                   (consp action-output))
  2010.                  (setq action-output (nth (car action-output) (cdr action-output))))
  2011.              (cond((stringp action-output)
  2012.                    (if (and its:*interactive* 
  2013.                     its:*insert-output-string*)
  2014.                    (funcall its:*insert-output-string* action-output)
  2015.                  (insert action-output)))
  2016.                   ((consp action-output)
  2017.                    (its:select-alternative-output action-output)
  2018.                    )
  2019.                   (t
  2020.                    (beep) (beep)
  2021.                    )))
  2022.                (cond((null (action-next action))
  2023.                  (cond ((and (= (point) its:*buff-e*)
  2024.                      its:*interactive*
  2025.                      (its:delete-charp (its:peek-char)))
  2026.                     nil)
  2027.                    (t
  2028.                     (set-marker its:*buff-s* (point))
  2029.                     (its:reset-maps)
  2030.                     (setq map topmap)
  2031.                     )))
  2032.                 (t
  2033.                  (save-excursion (insert (action-next action)))
  2034.                  (set-marker its:*buff-s* (point))
  2035.                  (its:reset-maps)
  2036.                  (setq map topmap))))
  2037.               ((symbolp action)
  2038.                (funcall action)
  2039.                (its:reset-maps its:*current-map*)
  2040.                (setq topmap its:*current-map*)
  2041.                (setq map topmap)
  2042.                (set-marker its:*buff-s* (point)))
  2043.               (t 
  2044.                (eval action)
  2045.                (its:reset-maps its:*current-map*)
  2046.                (setq topmap its:*current-map*)
  2047.                (setq map topmap)
  2048.                (set-marker its:*buff-s* (point)))))
  2049.            (t
  2050.         (if (and its:*interactive* 
  2051.              its:*display-status-string*)
  2052.             (funcall its:*display-status-string* (map-state map))
  2053.           (insert (map-state map)))))))
  2054.  
  2055.        ((null action)
  2056.     (delete-region its:*buff-s* (point))
  2057.     (if (and its:*interactive* 
  2058.          its:*display-status-string*)
  2059.         (funcall its:*display-status-string* (map-state newmap))
  2060.       (insert (map-state newmap)))
  2061.     (its:enter-newlevel (setq map newmap)
  2062.                 ch action))
  2063.  
  2064.        (t
  2065.     (its:enter-newlevel (setq map newmap) ch action)
  2066.     (delete-region its:*buff-s* (point))
  2067.     (if (and its:*interactive* 
  2068.          its:*display-status-string*)
  2069.         (funcall its:*display-status-string* (map-state map))
  2070.       (insert (map-state map))))))
  2071.  
  2072.     (set-marker its:*buff-s* nil)
  2073.     (set-marker its:*buff-e* nil)
  2074.     (if (and its:*interactive* ch) (setq unread-command-events (list (character-to-event ch))))
  2075.     ))
  2076.  
  2077. ;;;----------------------------------------------------------------------
  2078. ;;; 
  2079. ;;; ITS-map dump routine:
  2080. ;;;
  2081. ;;;----------------------------------------------------------------------
  2082.  
  2083. ;;;;;
  2084. ;;;;; User entry: dump-its-mode-map
  2085. ;;;;;
  2086.  
  2087. ;; 92.6.26 by K.Handa
  2088. (defun dump-its-mode-map (name filename)
  2089.   "Obsolete."
  2090.   (interactive)
  2091.   (message "This function is obsolete in the current version of Mule."))
  2092. ;;;
  2093. ;;; EGG mode variables
  2094. ;;;
  2095.  
  2096. (defvar egg:*mode-on* nil "T if egg mode is on.")
  2097. (make-variable-buffer-local 'egg:*mode-on*)
  2098. (set-default 'egg:*mode-on* nil)
  2099.  
  2100. (defvar egg:*input-mode* t "T if egg map is active.")
  2101. (make-variable-buffer-local 'egg:*input-mode*)
  2102. (set-default 'egg:*input-mode* t)
  2103.  
  2104. (defvar egg:*in-fence-mode* nil "T if in fence mode.")
  2105. (make-variable-buffer-local 'egg:*in-fence-mode*)
  2106. (set-default 'egg:*in-fence-mode* nil)
  2107.  
  2108. ;;(load-library "its-dump/roma-kana")         ;;;(define-its-mode "roma-kana"        " a$B$"(B")
  2109. ;;(load-library "its-dump/roma-kata")         ;;;(define-its-mode "roma-kata"        " a$B%"(B")
  2110. ;;(load-library "its-dump/downcase")          ;;;(define-its-mode "downcase"         " a a")
  2111. ;;(load-library "its-dump/upcase")            ;;;(define-its-mode "upcase"           " a A")
  2112. ;;(load-library "its-dump/zenkaku-downcase")  ;;;(define-its-mode "zenkaku-downcase" " a$B#a(B")
  2113. ;;(load-library "its-dump/zenkaku-upcase")    ;;;(define-its-mode "zenkaku-upcase"   " a$B#A(B")
  2114. ;; 92.3.13 by K.Handa
  2115. ;; (load "its-hira")
  2116. ;; (load-library "its-kata")
  2117. ;; (load-library "its-hankaku")
  2118. ;; (load-library "its-zenkaku")
  2119.  
  2120. (defvar its:*current-map* nil)
  2121. (make-variable-buffer-local 'its:*current-map*)
  2122. ;; 92.3.13 by K.Handa
  2123. ;; moved to each language specific setup files (japanese.el, ...)
  2124. ;; (setq-default its:*current-map* (its:get-mode-map "roma-kana"))
  2125.  
  2126. (defvar its:*previous-map* nil)
  2127. (make-variable-buffer-local 'its:*previous-map*)
  2128. (setq-default its:*previous-map* nil)
  2129.  
  2130. ;;;----------------------------------------------------------------------
  2131. ;;;
  2132. ;;; Mode line control functions;
  2133. ;;;
  2134. ;;;----------------------------------------------------------------------
  2135.  
  2136. (defconst mode-line-egg-mode "--")
  2137. (make-variable-buffer-local 'mode-line-egg-mode)
  2138.  
  2139. (defvar   mode-line-egg-mode-in-minibuffer "--" "global variable")
  2140.  
  2141. (defun egg:find-symbol-in-tree (item tree)
  2142.   (if (consp tree)
  2143.       (or (egg:find-symbol-in-tree item (car tree))
  2144.       (egg:find-symbol-in-tree item (cdr tree)))
  2145.     (equal item tree)))
  2146.  
  2147. ;;;
  2148. ;;; nemacs Ver. 3.0 $B$G$O(B Fselect_window $B$,JQ99$K$J$j!"(Bminibuffer-window
  2149. ;;; $BB>$N(B window $B$H$N4V$G=PF~$j$,$"$k$H!"(Bmode-line $B$N99?7$r9T$J$$!"JQ?t(B 
  2150. ;;; minibuffer-window-selected $B$NCM$,99?7$5$l$k(B
  2151. ;;;
  2152.  
  2153. ;;; nemacs Ver. 4 $B$G$O(B Fselect_window $B$,JQ99$K$J$j!$(Bselect-window-hook 
  2154. ;;; $B$,Dj5A$5$l$?!%$3$l$K$H$b$J$$=>Mh!$:FDj5A$7$F$$$?(B select-window,
  2155. ;;; other-window, keyborad-quit, abort-recursive-edit, exit-minibuffer 
  2156. ;;; $B$r:o=|$7$?!%(B
  2157.  
  2158. (defconst display-minibuffer-mode-in-minibuffer t)
  2159.  
  2160. (defvar minibuffer-window-selected nil)
  2161.  
  2162. (defun egg:select-window-hook (old new)
  2163.   (if (and (eq old (minibuffer-window))
  2164.            (not (eq new (minibuffer-window))))
  2165.       (save-excursion
  2166.     (set-buffer (window-buffer (minibuffer-window)))
  2167.     (set-minibuffer-preprompt nil)
  2168.     (setq egg:*mode-on* (default-value 'egg:*mode-on*)
  2169.           egg:*input-mode* (default-value 'egg:*input-mode*)
  2170.           egg:*in-fence-mode* (default-value 'egg:*in-fence-mode*))))
  2171.   (if (eq new (minibuffer-window))
  2172.       (setq minibuffer-window-selected t)
  2173.     (setq minibuffer-window-selected nil)))
  2174.  
  2175. (defun egg:minibuffer-entry-hook ()
  2176.   (setq minibuffer-window-selected t))
  2177.  
  2178. (defun egg:minibuffer-exit-hook ()
  2179.   "Call upon exit from minibufffer"
  2180.   (set-minibuffer-preprompt nil)
  2181.   (setq minibuffer-window-selected nil)
  2182.   (save-excursion
  2183.     (set-buffer (window-buffer (minibuffer-window)))
  2184.     (setq egg:*mode-on* (default-value 'egg:*mode-on*)
  2185.       egg:*input-mode* (default-value 'egg:*input-mode*)
  2186.       egg:*in-fence-mode* (default-value 'egg:*in-fence-mode*))))
  2187.   
  2188.  
  2189. ;;;
  2190. ;;;
  2191. ;;;
  2192.  
  2193. (defvar its:*reset-modeline-format* nil)
  2194.  
  2195.  
  2196.  
  2197. ;;;
  2198. ;;; minibuffer $B$G$N%b!<%II=<($r$9$k$?$a$K(B nemacs 4 $B$GDj5A$5$l$?(B 
  2199. ;;; minibuffer-preprompt $B$rMxMQ$9$k!%(B
  2200. ;;;
  2201.  
  2202. (defconst egg:minibuffer-preprompt '("[" nil "]"))
  2203.  
  2204. (defun mode-line-egg-mode-update (str)
  2205.   (if (eq (current-buffer) (window-buffer (minibuffer-window)))
  2206.       (if display-minibuffer-mode-in-minibuffer
  2207.       (progn
  2208.         (aset (nth 0 egg:minibuffer-preprompt) 0
  2209.           (if its:*previous-map* ?\< ?\[))
  2210.         (setcar (nthcdr 1 egg:minibuffer-preprompt)
  2211.             str)
  2212.         (aset (nth 2 egg:minibuffer-preprompt) 0
  2213.           (if its:*previous-map* ?\> ?\]))
  2214.         (set-minibuffer-preprompt (concat
  2215.                    (car egg:minibuffer-preprompt)
  2216.                    (car (nthcdr 1 egg:minibuffer-preprompt))
  2217.                    (car (nthcdr 2 egg:minibuffer-preprompt)))))
  2218.     (setq display-minibuffer-mode t
  2219.           mode-line-egg-mode-in-minibuffer str))
  2220.     (setq display-minibuffer-mode nil
  2221.       mode-line-egg-mode str))
  2222.   (redraw-modeline t))
  2223.  
  2224.  
  2225. ;;;
  2226. ;;; egg mode line display
  2227. ;;;
  2228.  
  2229. (defvar alphabet-mode-indicator "aA")
  2230. (defvar transparent-mode-indicator "--")
  2231.  
  2232. (defun egg:mode-line-display ()
  2233.   (mode-line-egg-mode-update 
  2234.    (cond((and egg:*in-fence-mode* (not egg:*input-mode*))
  2235.      alphabet-mode-indicator)
  2236.     ((and egg:*mode-on* egg:*input-mode*)
  2237.      (map-indicator its:*current-map*))
  2238.     (t transparent-mode-indicator))))
  2239.  
  2240. (defun egg:toggle-egg-mode-on-off ()
  2241.   (interactive)
  2242.   (setq egg:*mode-on* (not egg:*mode-on*))
  2243.   (egg:mode-line-display))
  2244.  
  2245. (defun its:select-mode (name)
  2246.   (interactive (list (completing-read "ITS mode: " its:*mode-alist*)))
  2247.   (if (its:get-mode-map name)
  2248.       (progn
  2249.     (setq its:*current-map* (its:get-mode-map name))
  2250.     (egg:mode-line-display))
  2251.     (beep)))
  2252.  
  2253. (defvar its:*select-mode-menu* '(menu "Mode:" nil))
  2254.  
  2255. (defun its:select-mode-from-menu ()
  2256.   (interactive)
  2257.   (setcar (nthcdr 2 its:*select-mode-menu*) its:*mode-alist*)
  2258.   (setq its:*current-map* (menu:select-from-menu its:*select-mode-menu*))
  2259.   (egg:mode-line-display))
  2260.  
  2261. (defvar its:*standard-modes* nil
  2262.   "List of standard mode-map of EGG."
  2263.   ;; 92.3.13 by K.Handa
  2264.   ;; moved to each language specific setup files (japanese.el, ...)
  2265.   ;; (list (its:get-mode-map "roma-kana")
  2266.   ;;  (its:get-mode-map "roma-kata")
  2267.   ;;  (its:get-mode-map "downcase")
  2268.   ;;  (its:get-mode-map "upcase")
  2269.   ;;  (its:get-mode-map "zenkaku-downcase")
  2270.   ;;  (its:get-mode-map "zenkaku-upcase"))
  2271.   )
  2272.  
  2273. (defun its:find (map list)
  2274.   (let ((n 0))
  2275.     (while (and list (not (eq map (car list))))
  2276.       (setq list (cdr list)
  2277.         n    (1+ n)))
  2278.     (if list n nil)))
  2279.  
  2280. (defun its:next-mode ()
  2281.   (interactive)
  2282.   (let ((pos (its:find its:*current-map* its:*standard-modes*)))
  2283.     (setq its:*current-map*
  2284.       (nth (% (1+ pos) (length its:*standard-modes*))
  2285.            its:*standard-modes*))
  2286.     (egg:mode-line-display)))
  2287.  
  2288. (defun its:previous-mode ()
  2289.   (interactive)
  2290.   (let ((pos (its:find its:*current-map* its:*standard-modes*)))
  2291.     (setq its:*current-map*
  2292.       (nth (1- (if (= pos 0) (length its:*standard-modes*) pos))
  2293.            its:*standard-modes*))
  2294.     (egg:mode-line-display)))
  2295.  
  2296. (defun its:select-hiragana () (interactive) (its:select-mode "roma-kana"))
  2297. (defun its:select-katakana () (interactive) (its:select-mode "roma-kata"))
  2298. (defun its:select-downcase () (interactive) (its:select-mode "downcase"))
  2299. (defun its:select-upcase   () (interactive) (its:select-mode "upcase"))
  2300. (defun its:select-zenkaku-downcase () (interactive) (its:select-mode "zenkaku-downcase"))
  2301. (defun its:select-zenkaku-upcase   () (interactive) (its:select-mode "zenkaku-upcase"))
  2302.  
  2303. (defun its:select-mode-temporally (name)
  2304.   (interactive (list (completing-read "ITS mode: " its:*mode-alist*)))
  2305.   (let ((map (its:get-mode-map name)))
  2306.     (if map
  2307.     (progn
  2308.       (if (null its:*previous-map*)
  2309.           (setq its:*previous-map* its:*current-map*))
  2310.       (setq its:*current-map*  map)
  2311.       (egg:mode-line-display))
  2312.       (beep))))
  2313.  
  2314. (defun its:select-previous-mode ()
  2315.   (interactive)
  2316.   (if (null its:*previous-map*)
  2317.       (beep)
  2318.     (setq its:*current-map* its:*previous-map*
  2319.       its:*previous-map* nil)
  2320.     (egg:mode-line-display)))
  2321.       
  2322.  
  2323. (defun toggle-egg-mode ()
  2324.   (interactive)
  2325.   (if egg:*mode-on* (fence-toggle-egg-mode)
  2326.     (progn
  2327.       (setq egg:*mode-on* t)
  2328.       (egg:mode-line-display))))
  2329.  
  2330. (defun fence-toggle-egg-mode ()
  2331.   (interactive)
  2332.   (if its:*current-map*
  2333.       (progn
  2334.     (setq egg:*input-mode* (not egg:*input-mode*))
  2335.     (egg:mode-line-display))
  2336.     (beep)))
  2337.  
  2338. ;;;
  2339. ;;; Changes on Global map 
  2340. ;;;
  2341.  
  2342. (defvar si:*global-map* (copy-keymap global-map))
  2343.  
  2344. (substitute-key-definition 'self-insert-command
  2345.                'egg-self-insert-command
  2346.                global-map)
  2347.  
  2348. ;; wire us into pending-delete
  2349. (put 'egg-self-insert-command 'pending-delete t)
  2350.  
  2351. ;;;
  2352. ;;; Currently entries C-\ and C-^ at global-map are undefined.
  2353. ;;;
  2354.  
  2355. ;; Make this no-op if LEIM interface is used.
  2356. (cond ((featurep 'egg-leim) t)
  2357.       (t (define-key global-map "\C-\\" 'toggle-egg-mode)) )
  2358. ;; #### Should hide bindings like this, too?  However, `convert-region'
  2359. ;;      probably isn't going to be a LEIM feature, it's really pretty
  2360. ;;      Japanese and Korean specific.
  2361. (define-key global-map "\C-x " 'henkan-region)
  2362.  
  2363. ;; 92.3.16 by K.Handa
  2364. ;; global-map => mule-keymap
  2365. (define-key mule-keymap "m" 'its:select-mode-from-menu)
  2366. (define-key mule-keymap ">" 'its:next-mode)
  2367. (define-key mule-keymap "<" 'its:previous-mode)
  2368. (define-key mule-keymap "h" 'its:select-hiragana)
  2369. (define-key mule-keymap "k" 'its:select-katakana)
  2370. (define-key mule-keymap "q" 'its:select-downcase)
  2371. (define-key mule-keymap "Q" 'its:select-upcase)
  2372. (define-key mule-keymap "z" 'its:select-zenkaku-downcase)
  2373. (define-key mule-keymap "Z" 'its:select-zenkaku-upcase)
  2374.  
  2375. ;;;
  2376. ;;; auto fill control
  2377. ;;;
  2378.  
  2379. (defun egg:do-auto-fill ()
  2380.   (if (and auto-fill-function (not buffer-read-only)
  2381.        (> (current-column) fill-column))
  2382.       (let ((ocolumn (current-column)))
  2383.     (funcall auto-fill-function)
  2384.     (while (and (< fill-column (current-column))
  2385.             (< (current-column) ocolumn))
  2386.         (setq ocolumn (current-column))
  2387.       (funcall auto-fill-function)))))
  2388.  
  2389. ;;;----------------------------------------------------------------------
  2390. ;;;
  2391. ;;;  Egg fence mode
  2392. ;;;
  2393. ;;;----------------------------------------------------------------------
  2394.  
  2395. (defconst egg:*fence-open*   "|" "*$B%U%'%s%9$N;OE@$r<($9J8;zNs(B")
  2396. (defconst egg:*fence-close*  "|" "*$B%U%'%s%9$N=*E@$r<($9J8;zNs(B")
  2397. (defconst egg:*fence-face* nil  "*$B%U%'%s%9I=<($KMQ$$$k(B face $B$^$?$O(B nil")
  2398. (make-variable-buffer-local
  2399.  (defvar egg:*fence-extent* nil "$B%U%'%s%9I=<(MQ(B extent"))
  2400.  
  2401. (defvar egg:*face-alist*
  2402.   '(("nil" . nil)
  2403.     ("highlight" . highlight) ("modeline" . modeline)
  2404.     ("inverse" . modeline) ("underline" . underline) ("bold" . bold)
  2405.     ("region" . region)))
  2406.  
  2407. (defun set-egg-fence-mode-format (open close &optional face)
  2408.   "fence mode $B$NI=<(J}K!$r@_Dj$9$k!#(BOPEN $B$O%U%'%s%9$N;OE@$r<($9J8;zNs$^$?$O(B nil$B!#(B\n\
  2409. CLOSE$B$O%U%'%s%9$N=*E@$r<($9J8;zNs$^$?$O(B nil$B!#(B\n\
  2410. $BBh(B3$B0z?t(B FACE $B$,;XDj$5$l$F(B nil $B$G$J$1$l$P!"%U%'%s%96h4V$NI=<($K$=$l$r;H$&!#(B"
  2411.   (interactive (list (read-string "$B%U%'%s%93+;OJ8;zNs(B: ")
  2412.              (read-string "$B%U%'%s%9=*N;J8;zNs(B: ")
  2413.              (cdr (assoc (completing-read "$B%U%'%s%9I=<(B0@-(B: " egg:*face-alist*)
  2414.                  egg:*face-alist*))))
  2415.  
  2416.   (if (and (or (stringp open) (null open))
  2417.        (or (stringp close) (null close))
  2418.        (or (null face) (memq face (face-list))))
  2419.       (progn
  2420.     (setq egg:*fence-open* (or open "")
  2421.           egg:*fence-close* (or close "")
  2422.           egg:*fence-face* face)
  2423.     (if (extentp egg:*fence-extent*)
  2424.         (set-extent-property egg:*fence-extent* 'face egg:*fence-face*))
  2425.     t)
  2426.     (error "Wrong type of argument: %s %s %s" open close face)))
  2427.  
  2428. (defvar egg:*region-start* nil)
  2429. (make-variable-buffer-local 'egg:*region-start*)
  2430. (set-default 'egg:*region-start* nil)
  2431. (defvar egg:*region-end* nil)
  2432. (make-variable-buffer-local 'egg:*region-end*)
  2433. (set-default 'egg:*region-end* nil)
  2434. (defvar egg:*global-map-backup* nil)
  2435. (defvar egg:*local-map-backup*  nil)
  2436.  
  2437.  
  2438. ;;; Moved to kanji.el
  2439. ;;; (defvar self-insert-after-hook nil
  2440. ;;;  "Hook to run when extended self insertion command exits. Should take
  2441. ;;; two arguments START and END correspoding to character position.")
  2442.  
  2443. (defvar egg:*self-insert-non-undo-count* 0
  2444.   "counter to hold repetition of egg-self-insert-command.")
  2445.  
  2446. (defun egg-self-insert-command (arg)
  2447.   (interactive "p")
  2448.   (if (and (not buffer-read-only)
  2449.        egg:*mode-on* egg:*input-mode* 
  2450.        (not egg:*in-fence-mode*) ;;; inhibit recursive fence mode
  2451.        (not (= (event-to-character last-command-event) ? )))
  2452.       (egg:enter-fence-mode-and-self-insert)
  2453.     (progn
  2454.       ;; treat continuous 20 self insert as a single undo chunk.
  2455.       ;; `20' is a magic number copied from keyboard.c
  2456.       (if (or                ;92.12.20 by T.Enami
  2457.        (not (eq last-command 'egg-self-insert-command))
  2458.        (>= egg:*self-insert-non-undo-count* 20))
  2459.       (setq egg:*self-insert-non-undo-count* 1)
  2460.     (cancel-undo-boundary)
  2461.     (setq egg:*self-insert-non-undo-count*
  2462.           (1+ egg:*self-insert-non-undo-count*)))
  2463.       (self-insert-command arg)
  2464.       (if egg-insert-after-hook
  2465.       (run-hooks 'egg-insert-after-hook))
  2466.       (if self-insert-after-hook
  2467.       (if (<= 1 arg)
  2468.           (funcall self-insert-after-hook
  2469.                (- (point) arg) (point)))
  2470.     (if (= (event-to-character last-command-event) ? ) (egg:do-auto-fill))))))
  2471.  
  2472. ;;
  2473. ;; $BA03NDjJQ49=hM}4X?t(B 
  2474. ;;
  2475. (defvar egg:*fence-open-backup* nil)
  2476. (defvar egg:*fence-close-backup* nil)
  2477. (defvar egg:*fence-face-backup* nil)
  2478.  
  2479. (defconst egg:*fence-open-in-cont* "+" "*$BA03NDj>uBV$G$N(B *fence-open*")
  2480. (defconst egg:*fence-close-in-cont* t "*$BA03NDj>uBV$G$N(B *fence-close*")
  2481. (defconst egg:*fence-face-in-cont* t
  2482.   "*$BA03NDj>uBV$G$N(B *fence-face*")
  2483.  
  2484. (defun set-egg-fence-mode-format-in-cont (open close face)
  2485.   "$BA03NDj>uBV$G$N(B fence mode $B$NI=<(J}K!$r@_Dj$9$k!#(BOPEN $B$O%U%'%s%9$N;OE@$r<($9J8(B
  2486. $B;zNs!"(Bt $B$^$?$O(B nil$B!#(B\n\
  2487. CLOSE$B$O%U%'%s%9$N=*E@$r<($9J8;zNs!"(Bt $B$^$?$O(B nil$B!#(B\n\
  2488. FACE $B$O(B nil $B$G$J$1$l$P!"%U%'%s%96h4V$NI=<($K$=$l$r;H$&!#(B\n\
  2489. $B$=$l$>$l$NCM$,(B t $B$N>l9g!"DL>o$N(B egg:*fence-open* $BEy$NCM$r0z$-7Q$0!#(B"
  2490.   (interactive (list (read-string "$B%U%'%s%93+;OJ8;zNs(B: ")
  2491.                      (read-string "$B%U%'%s%9=*N;J8;zNs(B: ")
  2492.                      (cdr (assoc (completing-read "$B%U%'%s%9I=<(B0@-(B: " egg:*face
  2493. -alist*)
  2494.                                  egg:*face-alist*))))
  2495.  
  2496.   (if (and (or (stringp open) (eq open t) (null open))
  2497.            (or (stringp close) (eq close t) (null close))
  2498.            (or (null face) (eq face t) (memq face (face-list))))
  2499.       (progn
  2500.         (setq egg:*fence-open-in-cont* (or open "")
  2501.               egg:*fence-close-in-cont* (or close "")
  2502.               egg:*fence-face-in-cont* face)
  2503.         (if (extentp egg:*fence-extent*)
  2504.             (set-extent-property egg:*fence-extent* 'face egg:*fence-face*))
  2505.         t)
  2506.     (error "Wrong type of argument: %s %s %s" open close face)))
  2507.  
  2508. (defvar *in-cont-flag* nil
  2509.  "$BD>A0$KJQ49$7$?D>8e$NF~NO$+$I$&$+$r<($9!#(B")
  2510.  
  2511. (defvar *in-cont-backup-flag* nil)
  2512.  
  2513. (defun egg:check-fence-in-cont ()
  2514.   (if *in-cont-flag*
  2515.       (progn
  2516.     (setq *in-cont-backup-flag* t)
  2517.     (setq egg:*fence-open-backup* egg:*fence-open*)
  2518.     (setq egg:*fence-close-backup* egg:*fence-close*)
  2519.     (setq egg:*fence-face-backup* egg:*fence-face*)
  2520.         (or (eq egg:*fence-open-in-cont* t)
  2521.             (setq egg:*fence-open* egg:*fence-open-in-cont*))
  2522.         (or (eq egg:*fence-close-in-cont* t)
  2523.             (setq egg:*fence-close* egg:*fence-close-in-cont*))
  2524.         (or (eq egg:*fence-face-in-cont* t)
  2525.             (setq egg:*fence-face* egg:*fence-face-in-cont*)))))
  2526.  
  2527. (defun egg:restore-fence-in-cont ()
  2528.   "Restore egg:*fence-open* and egg:*fence-close*"
  2529.   (if *in-cont-backup-flag* 
  2530.       (progn
  2531.     (setq egg:*fence-open* egg:*fence-open-backup*)
  2532.     (setq egg:*fence-close* egg:*fence-close-backup*)
  2533.     (setq egg:*fence-face* egg:*fence-face-backup*)))
  2534.   (setq *in-cont-backup-flag* nil)
  2535.   )
  2536.  
  2537. (defun egg:enter-fence-mode-and-self-insert () 
  2538.   (setq *in-cont-flag*
  2539.     (memq last-command '(henkan-kakutei henkan-kakutei-and-self-insert)))
  2540.   (enter-fence-mode)
  2541.   (setq unread-command-events (list last-command-event)))
  2542.  
  2543. (defun egg:fence-face-on ()
  2544.   (if egg:*fence-face*
  2545.       (progn
  2546.     (if (extentp egg:*fence-extent*)
  2547.         (set-extent-endpoints egg:*fence-extent* egg:*region-start* egg:*region-end*)
  2548.       (setq egg:*fence-extent* (make-extent egg:*region-start* egg:*region-end*))
  2549.       (set-extent-property egg:*fence-extent* 'start-open nil)
  2550.       (set-extent-property egg:*fence-extent* 'end-open nil)
  2551.       (set-extent-property egg:*fence-extent* 'detachable nil))
  2552.     (set-extent-face egg:*fence-extent* egg:*fence-face*))))
  2553.  
  2554. (defun egg:fence-face-off ()
  2555.   (and egg:*fence-face*
  2556.        (extentp egg:*fence-extent*)
  2557.        (detach-extent egg:*fence-extent*) ))
  2558.  
  2559. (defun enter-fence-mode ()
  2560.  
  2561.   ;; XEmacs change:
  2562. ;  (buffer-disable-undo (current-buffer))
  2563.   (undo-boundary)
  2564.   (setq egg:*in-fence-mode* t
  2565.     egg:fence-buffer (current-buffer))
  2566.   (egg:mode-line-display)
  2567.   ;;;(setq egg:*global-map-backup* (current-global-map))
  2568.   (setq egg:*local-map-backup*  (current-local-map))
  2569.   ;;;(use-global-map fence-mode-map)
  2570.   ;;;(use-local-map nil)
  2571.   (use-local-map fence-mode-map)
  2572.   (egg:check-fence-in-cont)            ; for Wnn6
  2573.   (insert egg:*fence-open*)
  2574.   (or (markerp egg:*region-start*) (setq egg:*region-start* (make-marker)))
  2575.   (set-marker egg:*region-start* (point))
  2576.   (insert egg:*fence-close*)
  2577.   (or (markerp egg:*region-end*) (set-marker-insertion-type (setq egg:*region-end* (make-marker)) t))
  2578.   (set-marker egg:*region-end* egg:*region-start*)
  2579.   (egg:fence-face-on)
  2580.   (goto-char egg:*region-start*)
  2581.   (add-hook 'post-command-hook 'fence-post-command-hook)
  2582.   )
  2583.  
  2584. (defun henkan-fence-region-or-single-space ()
  2585.   (interactive)
  2586.   (if egg:*input-mode*   
  2587.       (henkan-fence-region)
  2588.     (insert ? )))
  2589.  
  2590. (defvar egg:*henkan-fence-mode* nil)
  2591.  
  2592. (defun henkan-fence-region ()
  2593.   (interactive)
  2594.   (setq egg:*henkan-fence-mode* t)
  2595.   (egg:fence-face-off)
  2596.   (henkan-region-internal egg:*region-start* egg:*region-end* ))
  2597.  
  2598. (defun fence-katakana  ()
  2599.   (interactive)
  2600.   (katakana-region egg:*region-start* egg:*region-end* ))
  2601.  
  2602. (defun fence-hiragana  ()
  2603.   (interactive)
  2604.   (hiragana-region egg:*region-start* egg:*region-end*))
  2605.  
  2606. (defun fence-hankaku  ()
  2607.   (interactive)
  2608.   (hankaku-region egg:*region-start* egg:*region-end*))
  2609.  
  2610. (defun fence-zenkaku  ()
  2611.   (interactive)
  2612.   (zenkaku-region egg:*region-start* egg:*region-end*))
  2613.  
  2614. (defun fence-backward-char ()
  2615.   (interactive)
  2616.   (if (< egg:*region-start* (point))
  2617.       (backward-char)
  2618.     (beep)))
  2619.  
  2620. (defun fence-forward-char ()
  2621.   (interactive)
  2622.   (if (< (point) egg:*region-end*)
  2623.       (forward-char)
  2624.     (beep)))
  2625.  
  2626. (defun fence-beginning-of-line ()
  2627.   (interactive)
  2628.   (goto-char egg:*region-start*))
  2629.  
  2630. (defun fence-end-of-line ()
  2631.   (interactive)
  2632.   (goto-char egg:*region-end*))
  2633.  
  2634. (defun fence-transpose-chars (arg)
  2635.   (interactive "P")
  2636.   (if (and (< egg:*region-start* (point))
  2637.        (< (point) egg:*region-end*))
  2638.       (transpose-chars arg)
  2639.     (beep)))
  2640.  
  2641. (defun egg:exit-if-empty-region ()
  2642.   (if (= egg:*region-start* egg:*region-end*)
  2643.       (fence-exit-internal)))
  2644.  
  2645. (defun fence-delete-char ()
  2646.   (interactive)
  2647.   (if (< (point) egg:*region-end*)
  2648.       (progn
  2649.     (delete-char 1)
  2650.     (egg:exit-if-empty-region))
  2651.     (beep)))
  2652.  
  2653. (defun fence-backward-delete-char ()
  2654.   (interactive)
  2655.   (if (< egg:*region-start* (point))
  2656.       (progn
  2657.     (delete-char -1)
  2658.     (egg:exit-if-empty-region))
  2659.     (beep)))
  2660.  
  2661. (defun fence-kill-line ()
  2662.   (interactive)
  2663.   (delete-region (point) egg:*region-end*)
  2664.   (egg:exit-if-empty-region))
  2665.  
  2666. (defun fence-exit-mode ()
  2667.   (interactive)
  2668.   (fence-exit-internal))
  2669.  
  2670. (defun fence-exit-internal ()
  2671.   (egg:fence-face-off)
  2672.   (delete-region (- egg:*region-start* (length egg:*fence-open*)) egg:*region-start*)
  2673.   (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*fence-close*)))
  2674.   (if its:*previous-map*
  2675.       (setq its:*current-map* its:*previous-map*
  2676.         its:*previous-map* nil))
  2677.   (egg:quit-egg-mode))
  2678.  
  2679. ;; jhod: This seems bogus to me, as it should be called either after each
  2680. ;; egg-self-insert, or after accepting input, but not both. Otherwise, I can't
  2681. ;; really think of a use for it.
  2682. (defvar egg-insert-after-hook nil
  2683.   "Hook to run when egg inserts a character in the buffer")
  2684.  
  2685. (make-variable-buffer-local 'egg-insert-after-hook)
  2686.  
  2687. (defvar egg-exit-hook nil
  2688.   "Hook to run when egg exits. Should take two arguments START and END
  2689. correspoding to character position.")
  2690.  
  2691. (defun egg:quit-egg-mode ()
  2692.   ;;;(use-global-map egg:*global-map-backup*)
  2693.   (use-local-map egg:*local-map-backup*)
  2694.   (remove-hook 'post-command-hook 'fence-post-command-hook)
  2695.   (setq egg:*in-fence-mode* nil)
  2696.   (egg:mode-line-display)
  2697.   (if overwrite-mode
  2698.       (let ((str (buffer-substring egg:*region-end* egg:*region-start*)))
  2699.     (delete-text-in-column nil (+ (current-column) (string-width str)))))
  2700.   (egg:restore-fence-in-cont)               ; for Wnn6
  2701.   (setq egg:*henkan-fence-mode* nil)
  2702.   (if self-insert-after-hook
  2703.       (funcall self-insert-after-hook egg:*region-start* egg:*region-end*)
  2704.     (if egg-exit-hook
  2705.     (funcall egg-exit-hook egg:*region-start* egg:*region-end*)
  2706.       (if (not (= egg:*region-start* egg:*region-end*))
  2707.       (egg:do-auto-fill))))
  2708.   (set-marker egg:*region-start* nil)
  2709.   (set-marker egg:*region-end*   nil)
  2710.   ;; XEmacs change:
  2711. ;  (buffer-enable-undo (current-buffer))
  2712.   (if egg-insert-after-hook
  2713.       (run-hooks 'egg-insert-after-hook))
  2714.   )
  2715.  
  2716. (defun fence-cancel-input ()
  2717.   "Cancel all fence operations in the current buffer"
  2718.   (interactive)
  2719.   (fence-kill-operation))
  2720.  
  2721. (defun fence-kill-operation ()
  2722.   "Internal method to remove fences"
  2723.   (delete-region egg:*region-start* egg:*region-end*)
  2724.   (fence-exit-internal))
  2725.  
  2726. (defun fence-post-command-hook ()
  2727.   ;; For use as the value of `post-command-hook' when fence is active.
  2728.   ;; If we got out of the region specified by the fence,
  2729.   ;; kill the fence before that command is executed.
  2730.   ;;
  2731.   (cond ((not (eq (current-buffer) egg:fence-buffer))
  2732.      ;; If the buffer (likely meaning "frame") has changed, bail.
  2733.      ;; This can also happen if a proc filter has popped up another
  2734.      ;; buffer, which is arguably a bad thing for it to have done,
  2735.      ;; but the way in which egg would have hosed you in that
  2736.      ;; case is unarguably even worse.
  2737.      (save-excursion
  2738.        (set-buffer egg:fence-buffer)
  2739.        (its:reset-input)
  2740.        (fence-kill-operation)))
  2741.     ((or (< (point) egg:*region-start*)
  2742.          (> (point) egg:*region-end*))
  2743.      (save-excursion
  2744.        (its:reset-input)
  2745.        (fence-kill-operation)))))
  2746.  
  2747. (defun egg-lang-switch-callback ()
  2748.   "Do whatever processing is necessary when the language-environment changes."
  2749.   (if egg:*in-fence-mode*
  2750.       (progn
  2751.     (its:reset-input)
  2752.     (fence-kill-operation)))
  2753.   (let ((func (get current-language-environment 'set-egg-environ)))
  2754.     (if (not (null func))
  2755.       (funcall func)))
  2756.   (egg:mode-line-display))
  2757.  
  2758. (defun fence-mode-help-command ()
  2759.   "Display fence mode help"
  2760.   (interactive "_")
  2761.   (let ((w (selected-window)))
  2762.     (describe-function 'egg-mode)
  2763.     (ding)
  2764.     (select-window w)))
  2765.  
  2766. (defvar fence-mode-map (make-keymap))
  2767.  
  2768. (substitute-key-definition 'egg-self-insert-command
  2769.                'fence-self-insert-command
  2770.                fence-mode-map global-map)
  2771.  
  2772. (define-key fence-mode-map "\eh"  'fence-hiragana)
  2773. (define-key fence-mode-map "\ek"  'fence-katakana)
  2774. (define-key fence-mode-map "\e<"  'fence-hankaku)
  2775. (define-key fence-mode-map "\e>"  'fence-zenkaku)
  2776. (define-key fence-mode-map "\e\C-h" 'its:select-hiragana)
  2777. (define-key fence-mode-map "\e\C-k" 'its:select-katakana)
  2778. (define-key fence-mode-map "\eq"    'its:select-downcase)
  2779. (define-key fence-mode-map "\eQ"    'its:select-upcase)
  2780. (define-key fence-mode-map "\ez"    'its:select-zenkaku-downcase)
  2781. (define-key fence-mode-map "\eZ"    'its:select-zenkaku-upcase)
  2782. (define-key fence-mode-map " "    'henkan-fence-region-or-single-space)
  2783. (define-key fence-mode-map "\C-@" 'henkan-fence-region)
  2784. (define-key fence-mode-map [(control \ )] 'henkan-fence-region)
  2785. (define-key fence-mode-map "\C-a" 'fence-beginning-of-line)
  2786. (define-key fence-mode-map "\C-b" 'fence-backward-char)
  2787. (define-key fence-mode-map "\C-c" 'fence-cancel-input)
  2788. (define-key fence-mode-map "\C-d" 'fence-delete-char)
  2789. (define-key fence-mode-map "\C-e" 'fence-end-of-line)
  2790. (define-key fence-mode-map "\C-f" 'fence-forward-char)
  2791. (define-key fence-mode-map "\C-g" 'fence-cancel-input)
  2792. (define-key fence-mode-map "\C-k" 'fence-kill-line)
  2793. (define-key fence-mode-map "\C-l" 'fence-exit-mode)
  2794. (define-key fence-mode-map "\C-m" 'fence-exit-mode)  ;;; RET
  2795. (define-key fence-mode-map [return] 'fence-exit-mode)
  2796. (define-key fence-mode-map "\C-q" 'its:select-previous-mode)
  2797. (define-key fence-mode-map "\C-t" 'fence-transpose-chars)
  2798. (define-key fence-mode-map "\C-w" 'henkan-fence-region)
  2799. (define-key fence-mode-map "\C-z" 'eval-expression)
  2800. (define-key fence-mode-map "\C-\\" 'fence-toggle-egg-mode)
  2801. (define-key fence-mode-map "\C-_" 'jis-code-input)
  2802. (define-key fence-mode-map "\177" 'fence-backward-delete-char)
  2803. (define-key fence-mode-map [delete] 'fence-backward-delete-char)
  2804. (define-key fence-mode-map 'backspace 'fence-backward-delete-char)
  2805. (define-key fence-mode-map '(control h) 'fence-mode-help-command)
  2806. (define-key fence-mode-map [right] 'fence-forward-char)
  2807. (define-key fence-mode-map [left] 'fence-backward-char)
  2808.  
  2809. ;;;----------------------------------------------------------------------
  2810. ;;;
  2811. ;;; Read hiragana from minibuffer
  2812. ;;;
  2813. ;;;----------------------------------------------------------------------
  2814.  
  2815. (defvar egg:*minibuffer-local-hiragana-map* (copy-keymap minibuffer-local-map))
  2816.  
  2817. (substitute-key-definition 'egg-self-insert-command
  2818.                'fence-self-insert-command
  2819.                egg:*minibuffer-local-hiragana-map*
  2820.                global-map)
  2821.  
  2822. (defun read-hiragana-string (prompt &optional initial-input)
  2823.   (let ((egg:fence-buffer (window-buffer (minibuffer-window)))
  2824.     (minibuffer-exit-hook
  2825.      (append minibuffer-exit-hook
  2826.          '((lambda () (use-local-map minibuffer-local-map))))))
  2827.     (save-excursion
  2828.       (set-buffer egg:fence-buffer)
  2829.       (setq egg:*input-mode* t
  2830.         egg:*mode-on*    t
  2831.         its:*current-map* (its:get-mode-map "roma-kana"))
  2832.       (mode-line-egg-mode-update (its:get-mode-indicator "roma-kana")))
  2833.     (read-from-minibuffer prompt initial-input
  2834.               egg:*minibuffer-local-hiragana-map*)))
  2835.  
  2836. (defun read-kanji-string (prompt &optional initial-input)
  2837.   (save-excursion
  2838.     (let ((minibuff (window-buffer (minibuffer-window))))
  2839.       (set-buffer minibuff)
  2840.       (setq egg:*input-mode* t
  2841.         egg:*mode-on*    t
  2842.         its:*current-map* (its:get-mode-map "roma-kana"))
  2843.       (mode-line-egg-mode-update (its:get-mode-indicator "roma-kana"))))
  2844.   (read-from-minibuffer prompt initial-input))
  2845.  
  2846. (defconst isearch:read-kanji-string 'read-kanji-string)
  2847.  
  2848. ;;; $B5-9fF~NO(B
  2849.  
  2850. (defvar special-symbol-input-point nil)
  2851.  
  2852. (defun special-symbol-input ()
  2853.   (interactive)
  2854.   (require 'egg-jsymbol)
  2855.   ;; 92.7.8 by Y.Kawabe
  2856.   (let ((item (menu:select-from-menu
  2857.            *symbol-input-menu* special-symbol-input-point t))
  2858.     (code t))
  2859.     (and (listp item)
  2860.      (setq code (car item) special-symbol-input-point (cdr item)))
  2861.     ;; end of patch
  2862.     (cond((stringp code) (insert code))
  2863.      ((consp code) (eval code))
  2864.      )))
  2865.  
  2866.  
  2867. ;; (autoload 'busyu-input "egg-busyu" nil t)
  2868. ;; (autoload 'kakusuu-input "egg-busyu" nil t)
  2869.  
  2870. (defun egg-mode ()
  2871.   "The keys that are defined for the fence mode in egg are:\\{fence-mode-map}"
  2872.   (interactive)
  2873.   (define-key global-map "\C-^"  'special-symbol-input)
  2874.   (if (not (egg:find-symbol-in-tree 'mode-line-egg-mode modeline-format))
  2875.       (setq-default 
  2876.        modeline-format
  2877.        (cons (list 'display-minibuffer-mode-in-minibuffer
  2878.          ;;; minibuffer mode in minibuffer
  2879.            (list 
  2880.             (list 'its:*previous-map* "<" "[")
  2881.             'mode-line-egg-mode
  2882.             (list 'its:*previous-map* ">" "]")
  2883.             )
  2884.                ;;;; minibuffer mode in mode line
  2885.            (list 
  2886.             (list 'minibuffer-window-selected
  2887.               (list 'display-minibuffer-mode
  2888.                 "m"
  2889.                 " ")
  2890.               " ")
  2891.             (list 'its:*previous-map* "<" "[")
  2892.             (list 'minibuffer-window-selected
  2893.               (list 'display-minibuffer-mode
  2894.                 'mode-line-egg-mode-in-minibuffer
  2895.                 'mode-line-egg-mode)
  2896.               'mode-line-egg-mode)
  2897.             (list 'its:*previous-map* ">" "]")
  2898.             ))
  2899.          modeline-format)))
  2900.   ;; put us into the modeline of all existing buffers
  2901.   (mapc (lambda (buf)
  2902.       (save-excursion
  2903.         (set-buffer buf)
  2904.         (if (not (egg:find-symbol-in-tree 'mode-line-egg-mode modeline-format))
  2905.         (setq modeline-format
  2906.               (cons (list 'display-minibuffer-mode-in-minibuffer
  2907.          ;;; minibuffer mode in minibuffer
  2908.                   (list 
  2909.                    (list 'its:*previous-map* "<" "[")
  2910.                    'mode-line-egg-mode
  2911.                    (list 'its:*previous-map* ">" "]")
  2912.                    )
  2913.                ;;;; minibuffer mode in mode line
  2914.                   (list 
  2915.                    (list 'minibuffer-window-selected
  2916.                      (list 'display-minibuffer-mode
  2917.                            "m"
  2918.                            " ")
  2919.                      " ")
  2920.                    (list 'its:*previous-map* "<" "[")
  2921.                    (list 'minibuffer-window-selected
  2922.                      (list 'display-minibuffer-mode
  2923.                            'mode-line-egg-mode-in-minibuffer
  2924.                            'mode-line-egg-mode)
  2925.                      'mode-line-egg-mode)
  2926.                    (list 'its:*previous-map* ">" "]")
  2927.                    ))
  2928.                 modeline-format)))))
  2929.     (buffer-list))
  2930.   (if (boundp 'select-window-hook)
  2931.       (add-hook 'select-window-hook 'egg:select-window-hook)
  2932.     (add-hook 'minibuffer-exit-hook 'egg:minibuffer-exit-hook)
  2933.     (add-hook 'minibuffer-entry-hook 'egg:minibuffer-entry-hook))
  2934.   (mode-line-egg-mode-update mode-line-egg-mode)
  2935.   (if its:*reset-modeline-format*
  2936.       (setq-default modeline-format
  2937.             (cdr modeline-format)))
  2938.  
  2939.   ;; if set-lang-environment has already been called,
  2940.   ;; call egg-lang-switch-callback
  2941.   (if (not (null current-language-environment))
  2942.       (egg-lang-switch-callback))
  2943.   )
  2944.  
  2945. (provide 'egg)
  2946.  
  2947. ;;; egg.el ends here
  2948.